perm filename SCOLB.F4[MUS,LCS]1 blob
sn#138836 filedate 1973-08-06 generic text, type T, neo UTF8
00100 C THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
00200 C AT STANFORD UNIVERSITY. IT MAY NOT BE COPIED OR ALTERED IN ANY
00300 C WAY WITHOUT WRITTEN PERMISSION OF THE AUTHOR.
00400
00500
00600 C 6/10/72 ********** SCORE ********** LELAND SMITH, SEP.1969
00700
00800 C THIS PROGRAM WRITES NOTE LISTS FOR THE PDP10 SOUND
00900 C GENERATION PROGRAM.
01000 C IF # OF INSTS IS CHANGED, ALSO CHANGE # IN 'INFO' FORMAT.
01100 C LOAD 'SCORE' WITH BRZ.REL (RAN. NUM GENERATOR),SPRINT.MAC AND,
01200 C SCANX, (AND QUAD AND QUADO WHEN THEY ARE READY) AND
01300 C IF DESIRED, A SUBROUTINE WITH THE FOLLOWING HEADING:
01400 C SUBROUTINE SUBR
01500 C COMMON /INS/ INST(27),BG(60)
01600 C COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF
01700 C INUM=INST# IPAR=PARAM#
01800 C BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
01900 C IF IREST IS <0, THAT NOTE WILL BE A REST.
02000 C INST=INST. NAME, BG=INSTS' BEGIN TIMES.
02100 C NOTE #S IN SUBROUTINE: (1-84) C4=37 FS4=43 C5=49 ETC.
02200 C F1=86 F15=100 (NO F16!)
02300
02400 COMMON /Q/ BNW(100),NWZ
02500 COMMON /INS/INST,BG
02600 DIMENSION ROFF(27),V(2000),NP(27),PCH(27,32),INST(27)
02700 1 ,RDEV(27),IPT(27,31),XT(27),BG(60),OTH(20,16),SCAL(101)
02800 1 ,IV(2000),NCNT(27,32),P1(27),IT(30),JFM(4)
02900 1 ,IOUT(70),IFM(80),COPY(30),LIST(78),JPT(837)
03000 1 ,FINM(6),TINST(5),TPALN(4),ENFI(5),TEDIT(4),INVIS(27)
03100 C WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY
03200 C 40 LIT CHARS + 30 PARAMS PER INST.
03300 C 60 BG TIMES AVAILABLE. FOR INSTS AND INSERTS AND EDITS.
03400 COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
03500 1 ,IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
03600 1 ,INP(72),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
03700 EQUIVALENCE (PP1,P(1)),(P(2),P2),(P(3),P3),(P(4),P4),
03800 1 (VX1,VX(1)),(INP1,INP(1)),(PL4,PL(4)),(IPP,ISCA(2))
03900 1 ,(IEN,ISCA(4)),(IPT,JPT),(ISS,ISCA(9)),(ITT,ISCA(11))
04000 1 ,(IE,ISCA(5)),(ID,ISCA(3)),(IF,ISCA(6)),(IAA,ISCA(10))
04100 1 ,(VX2,VX(2)),(VX3,VX(3)),(NCNT,PCH),(VX4,VX(4))
04200 1 ,(VX5,VX(5)),(IDOT,IDAT(11)),(VX,IOUT),(IFM3,IFM(3))
04300 1 ,(IT,INP(27)),(V,IV),(PLAY,ISCA(7)),(IFM2,IFM(2))
04400 1 ,(IFM4,IFM(4)),(IFM(3),LIST)
04500 DATA KZY/27/,ISEMI/';'/,RTF/.05/,IQT/'"'/
04600 1, JFM(3)/','/
04700 C IAA=A ID=D IE=E IF=F IEN=N IPP=P ISS=S ITT=T
04800 DATA KSLA/'/'/,IBLA/' '/,BLA/' '/,IXX/'X'/,ITMPO/'TEMPO'/
04900 1 ,ISCA/'C','P','D','N','E','F','PLAY;','G','S','A','T','B'/
05000 1 ,IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
05100 1 ,SCAL/'C/8','CS/8','D/8','DS/8','E/8','F/8','FS/8','G/8',
05200 1 'GS/8','A/8','AS/8','B/8','C/4','CS/4','D/4','DS/4','E/4',
05300 1 'F/4','FS/4','G/4','GS/4','A/4','AS/4','B/4','C/2','CS/2',
05400 1 'D/2','DS/2','E/2','F/2','FS/2','G/2','GS/2','A/2','AS/2',
05500 1 'B/2','C','CS','D','DS','E','F','FS','G','GS','A','AS',
05600 1 'B','C*2','CS*2','D*2','DS*2','E*2','F*2','FS*2','G*2',
05700 1 'GS*2','A*2','AS*2','B*2','C*4','CS*4','D*4','DS*4','E*4',
05800 1 'F*4','FS*4','G*4','GS*4','A*4','AS*4','B*4','C*8','CS*8',
05900 1 'D*8','DS*8','E*8','F*8','FS*8','G*8','GS*8','A*8','AS*8',
06000 1 'B*8','R','F1','F2','F3','F4','F5','F6','F7','F8','F9',
06100 1 'F10','F11','F12','F13','F14','F15','END'/,I1X/'1X'/
06200 1 ,IFM(1)/'('/,IFM2/'1XA5,'/,IFCOM/5H', ',/,IA1/'A1,'/
06300 LPAR=0
06400 IPRN=0
06500 QX=0.
06600 MOT=0
06700 RETRO=-1.
06800 INVRT=-1
06900 LCNT=1
07000 PARENS=0
07100 JZ=1
07200 CALL RNDINT
07300 PR=0
07400 IAMP=0
07500 C IAMP IS 'BLANK LINE'FLAG ON PP1-3.
07600 T5=0
07700 NINS=0
07800 K=0
07900 IDALL=-1
08000 QTS=-1.
08100 KB=0
08200 NWZ=1
08300 BNW(1)=0
08400 I=1
08500 KL=0
08600 TP=0
08700 KN=IBLA
08800 RA=0
08900 CHN=0
09000 DO 127 K=1,77,3
09100 127 LIST(K)=0
09200 C INITIALIZES MOTIVIC LIST FOR ERROR FINDING ROUTINE.
09300 NWX=0
09400 BY=-1
09500 DO 1128 K=1,KZY
09600 INVIS(K)=0
09700 INST(K)=0
09800 CNT(K)=0
09900 RDEV(K)=0
10000 C RDEV IS FOR RAND DEVIATIONS AT RUN TIME
10100 NP(K)=0
10200 IQ(K)=0
10300 C IQ IS FOR RESTART FLAG
10400 IPT(K,1)=0
10500 DO 1128 L=1,32
10600 1128 PCH(K,L)=0
10700
10800 ITYP=-1
10900 C TYPE 'FILE NAME', TEMPO FACTOR(0=1), AMPL.FACT(0=1),
11000 C SECONDS TO BE OMITTED, DUR AT CUTOFF.
11100 JED=-1
11200 2112 TYPE 8002
11300 1112 ACCEPT 77732,INP
11400 JFM(4)='5F)'
11500 JFM(1)=' (A'
11600 C FOR FREE 'A' FORMAT
11700 CALL FMT(JFM,INP,MLX)
11800 REREAD JFM,K,TF,AMPFAC,OP1,DURX
11900 C JFM IS THE CURRENT FORMAT STATEMENT
12000 IF(K.NE.'EDIT')GO TO 3112
12100 JED=0
12200 GO TO 2112
12300 C 'E(DIT)' GOES TO EDIT MODE
12400 3112 IF(TF.EQ.0)TF=1.
12500 IF(AMPFAC.EQ.0)AMPFAC=1.
12600 CC**FROM 11700 CHANGED 3/73 IF(TF.NE.999.)GO TO 21122
12700 21122 IF(K.NE.'TYPE')GO TO 128
12800 ITYP=0
12900 DATA FINM/30H(' TYPE OUTPUT FILE NAME'/) /
13000 TYPE FINM
13100 C TO USE TYPE-IN MODE. FILE OF INPUT IS WRITTEN ON FOR21.DAT
13200 ACCEPT 1127,ISLAC
13300 IF(ISLAC.EQ.IBLA)STOP
13400 REWIND 21
13500 CC WRITE (21,11122) ISLAC
13600 WRITE (21,1127) ISLAC
13700 GO TO 3127
13800 11122 FORMAT(1XA5,72A1)
13900 128 IF(K.NE.'INFO')GO TO 3128
14000 TYPE 8002
14100 TYPE 1113
14200 TYPE 118
14300 TYPE 1114
14400 TYPE 8002
14500 GO TO 1112
14600 118 FORMAT(' TO DSK=1, TTY=2, BOTH=0, LPT=22, PROOF=3, DEBUG=4'/)
14700 8002 FORMAT(' TYPE FILE NAME'/)
14800 8001 FORMAT(A5,5F)
14900 107 FORMAT(I,A5,5F)
15000 1113 FORMAT(' NAME, TF, AMPFAC, OMIT", DUR".'/)
15100 1114 FORMAT(' N1, N2=RAN NUM, N3=0 LISTS INPUT, N4=SINGLE INST.'/
15200 1 ' IF -- N1=3 DURS ONLY, =4 V ARRAY'/
15300 1 3X' 27 INSTRUMENTS ARE AVAILABLE'/)
15400 1127 FORMAT(A5,72A1)
15500 3128 IF(K.NE.IBLA)IFLNM=K
15600 CALL IFILE(1,IFLNM)
15700 READ(1,107)LN,ISLAC
15800 REREAD 77732,INP
15900 C FOR LATER USE
16000 IF(LN.NE.0)GO TO 3127
16100 C JUMP IF THE FILE HAS LINE NUMBERS.
16200 REREAD 1127,ISLAC
16300 C REREADS FIRST LINE
16400 CC IF(ISLAC.NE.'COMME')GO TO 3127
16500 CC DO 31271 K=1,72
16600 CC READ(1,77732),KL,KL
16700 CC31271 IF(KL.EQ.ISEMI)GO TO 3127
16800 C TO SKIP OVER 'COMMENT' SECTION OF TVED FILES.
16900
17000 3127 TYPE 118
17100 IF(DURX.EQ.0)DURX=19999.
17200 IXIN=1
17300 CC -- NOW AT TOP OF PAGE 4(2/74) DO 1107 K=1,30
17400 CC1107 PL(K)=1.
17500 INONLY=-1
17600 ACCEPT 300,MX,X,Y,Z
17700 IF(Z.NE.0)INONLY=Z
17800 IF(X.NE.0)IXIN=X
17900 C MX=3 GIVES DURS ONLY
18000 C TO SUPPRESS LIST OF INPUT DATA, TYPE ANY 3RD NUM. (BUT 9.)
18100 C (1 1 1 =RECORD,RAN. NUM=1,SUPPRESS INPUT.)
18200 MZ=0
18300 JOUT=5
18400 C 5=OUTPUT TO TTY
18500 SOS=-1.
18600 IF(Y.NE.0)SOS=0
18700 C IF 3RD NUM≠0, EDIT FILE WILL PRINT AS IT IS READ.
18800 IF(MX.NE.22)GO TO 2107
18900 JOUT=22
19000 REWIND 22
19100 2107 IF(MX.LE.1)MX=MX-2
19200 IF(MX.EQ.-2.OR.MX.EQ.2.OR.MX.EQ.22)MZ=-1
19300 IF(MX.EQ.4)MZ=-4
19400 IF(SOS.AND.ITYP)WRITE(JOUT,87732)INP
19500 CC IF(ITYP.EQ.0)GO TO 2308
19600 CC WRITE(JOUT,77732)INP
19700
19800 C *************** READS INPUT ***********************
19900 2308 IF(ITYP)GO TO 2127
20000 DATA TINST /25H(' TYPE INST NAME, ETC'/)/
20100 1,TEDIT/20H(' RETYPE LINE?'/ )/
20200 23081 TYPE TINST
20300 ACCEPT 77732,INP
20400 IF(JED)WRITE(21,77732)INP
20500 JFM(4)='72A1)'
20600 C PUTS ON LPT AND TTY
20700 CC JFM(1)=' (A'
20800 CC CALL FMT(JFM,INP,MLX)
20900 CC REREAD JFM,J,INP
21000 CC WRITE(21,11122) J,INP
21100 GO TO 1074
21200 2127 JREAD=1
21300 4400 READ(1,77732,END=2337)INP
21400 IF(SOS)WRITE(JOUT,87732)INP
21500 GO TO(441,442,443,444,445,446)JREAD
21600
21700 441 JFM(4)='72A1)'
21800 IF(LN.EQ.0)GO TO 1074
21900 REREAD 2114,LN,INP
22000 JFM(1)=' (I,A'
22100 CALL FMT(JFM,INP,MLX)
22200 REREAD JFM,LN,J,INP
22300 GO TO 4127
22400 1074 JFM(1)=' (A'
22500 CALL FMT(JFM,INP,MLX)
22600 REREAD JFM,J,INP
22700 CC IF(LN.EQ.0)READ(1,1127,END=2337)J,INP
22800 4127 IF(JED.OR.K.EQ.'Y')GO TO 41271
22900 C K CHECK IS TO PASS AFTER RETYPING
23000 TYPE TEDIT
23100 ACCEPT 77732,K
23200 IF(K.EQ.'Y')GO TO 23081
23300 IF(K.EQ.'G')JED=-1
23400
23500
23600 41271 IF(J.EQ.IBLA)GO TO 2308
23700 MLX=1
23800 IZ=0
23900 JA=-1
24000 ISUB=4
24100 ALL=1.
24200 VX1=0
24300 VX2=0
24400 VX3=0
24500 LK=-1
24600 K=0
24700 IF(V(I-1).NE.-9900.-BY)GO TO 364
24800 BY=-1.
24900 I=I-1
25000 364 DO 361 JD=1,72
25100 N=INP(JD)
25200 IF(N.NE.'R')GO TO 361
25300 C LOOKS FOR 'RESTART'
25400 DO 3611 M=JD,72
25500 KL=INP(M)
25600 IF(KL.EQ.IBLA.OR.KL.EQ.ISEMI.OR.KL.EQ.KSLA.OR.KL.EQ.',')GO TO 3631
25700 CC IF(INP(M).EQ.IBLA)GO TO 3631
25800 3611 INP(M)=IBLA
25900 C CHANGES 'RESTART' TO BLANKS
26000 3631 DO 363 N=1,NINS
26100 IF(J.NE.INST(N))GO TO 363
26200 IQ(N)=-1
26300 C SETS RESTART FLAG. THIS INST WILL NOW APPEAR WITH NEW NUM.
26400 GO TO 362
26500 363 CONTINUE
26600 361 IF(N.EQ.KSLA.OR.N.EQ.ISEMI)GO TO 6773
26700 6773 K=K+1
26800 IF(K.GT.NINS)GO TO 36
26900 IF(INST(K).NE.J.OR.IQ(K).EQ.-1)GO TO 6773
27000 C FINDS CORRECT INST NUM. PASSES RESTARTED INSTS.
27100 LK=K
27200 GO TO 1773
27300 36 IF(J.EQ.'RUN;'.OR.J.EQ.'RUN')GO TO 2337
27400 IF(J.EQ.'INSER'.OR.J.EQ.'EDIT')ISUB=6
27500 IF(J.EQ.ITMPO.OR.J.EQ.'CONDU'.OR.J.EQ.'PLAY'.OR.ISUB.GT.4)
27600 1GO TO 1773
27700 IF(J.EQ.'SECTI')GO TO 1081
27800 C****************** ABOVE AND BELOW FOR 'SECTIONS'
27900 IF(J.EQ.'END'.OR.J.EQ.'END S'.OR.J.EQ.'FINIS')GO TO 1082
28000 362 LK=NINS+1
28100 IF(LK.GT.KZY)GO TO 99
28200 INST(LK)=J
28300 IZ=LK
28400 GO TO 1773
28500
28600 C*********** DOWN TO 99 FOR 'SECTIONS'
28700 1083 V(I)=-99.
28800 KL=1
28900 GO TO 3083
29000 C READS 'PLAY SECT. N1,N2'
29100 1081 V(I)=-199.
29200 KL=4
29300 3083 DO 2081 K=KL,72
29400 IF(INP(K).EQ.IBLA)GO TO 2081
29500 IV(I+1)=INP(K)
29600 I=I+2
29700 3081 BY=-1.
29800 GO TO 2308
29900 2081 CONTINUE
30000 C READS SECTION IDENTIFIER, -199. MARKS BEGINNING
30100 C1082 IF(V(I-1).EQ.-9900.-BY)I=I-1
30200 C********* FEB 15,71
30300 1082 V(I)=-299.
30400 I=I+1
30500 GO TO 3081
30600 C MARKS END OF SECTION
30700 C************************
30800
30900 99 TYPE 199,LN
31000 STOP
31100 199 FORMAT(' ERROR!! LAST LINE READ =',I6/)
31200 4 IF(LK.LE.NINS)GO TO 8773
31300 IF(ALL.GT.0)GO TO 1004
31400 IF(IDALL.GT.0)GO TO 8773
31500 BG(LK)=VX1
31600 IDALL=LK
31700 GO TO 2004
31800 C 'MOVE' CHANGES IN 'ALINS' CAN'T BE RESET IN INDIV. INSTS.
31900 1004 BG(LK)=VX1
32000 IF(LK.EQ.IZ)VX1=0
32100 C MAY 3,71 **** ALL PARAMS WILL BE SET UP AT TIME 0.
32200 C CHECK EFFECT ON 'MOVE'!
32300 C ******** APR.23, 1971 FIXES BG TIMES IN 'MOVE'?????!!!!!!!
32400 2004 NINS=LK
32500 IF(VX3.NE.0)VX2=10000.+VX3
32600 IF(VX2.EQ.0)VX2=-1
32700 DUR(LK)=VX2
32800 GO TO 900
32900 C******** ABOVE FOR REST ONLY ENTRIES. FEB 18,71
33000 8773 IF(VX2.NE.0)VX1=VX1*10000.+VX2
33100 900 IF(VX1.EQ.BY.AND.J.NE.'PLAY')GO TO 5773
33200 C*********** 'PLAY' IS FOR 'SECTIONS'
33300 BY=VX1
33400 C BY=CURRENT BG TIME.
33500 C********* FEB 15,71
33600 V(I)=-9900.-BY
33700 I=I+1
33800 IF(NWZ.NE.0)CALL BGSORT(BY)
33900 5773 IF(J.EQ.'TEMPO')GO TO 1106
34000 IF(J.EQ.'CONDU')GO TO 3018
34100 IF(J.EQ.'PLAY')GO TO 1083
34200 C*********** ABOVE FOR 'SECTIONS'
34300 4773 NW=LPAR
34400 IF(I.GT.1900.)TYPE 107,I
34500 ALL=1.
34600 DF=0
34700 ISUB=1
34800 1299 IF(JZ.NE.0)GO TO 1773
34900
35000
35100 7773 IF(ITYP)GO TO 77731
35200 DATA TPALN /20H(' TYPE A LINE'/) /
35300 77734 TYPE TPALN
35400 ACCEPT 77732,INP
35500 IF(JED)WRITE(21,77732) INP
35600 IF(INP1.EQ.IBLA)GO TO 77734
35700 GO TO 77733
35800 77732 FORMAT(72A1)
35900 87732 FORMAT(1X72A1)
36000 77731 JREAD=2
36100 GO TO 4400
36200 442 IF(LN.NE.0)REREAD 2114,LN,INP
36300 IF(INP1.EQ.IBLA)GO TO 77731
36400 IF(JED)GO TO 77733
36500 TYPE TEDIT
36600 ACCEPT 77732,K
36700 IF(K.EQ.'Y')GO TO 77734
36800 IF(K.EQ.'G')JED=-1
36900 C DOESN'T WORK FOR EDITS AND INSERTS YET???
37000 CC IF(SOS)WRITE(JOUT,2114),LN,INP
37100
37200
37300 77733 MLX=1
37400 C 'LISTS' MUST END WITH *
37500 CC1773 JZ=0
37600 1773 IF(IPRN.EQ.0)GO TO 17732
37700 L=I-1
37800 IF(QTS.AND.V(I-1).EQ.999.)L=L-1
37900 IPRN=IPRN-1
38000 IF(PARENS.EQ.0)GO TO 17733
38100 PARENS=0
38200 LIST(LCNT+2)=L
38300 LCNT=LCNT+3
38400 IF(IPRN.EQ.0)GO TO 17732
38500 IPRN=0
38600 17733 LIST(MOT)=L
38700 MOT=0
38800 C FOR ERROR TRAP
38900
39000 17732 JZ=0
39100 N=0
39200 17731 ML=MLX
39300
39400 C BIG LOOP -- TO END OF PAGE 1.
39500 JD=ML
39600 975 N=INP(JD)
39700 IF(N.EQ.IBLA.OR.N.EQ.',')GO TO 236
39800 C ((((())))) MAY 13,71 /Z (D4/E/X 2 3)/ CS/ ETC. CAN USE 26 LABELS.
39900 33611 IF(N.NE.'('.AND.N.NE.')')GO TO 2361
40000 INP(JD)=IBLA
40100 L=JD-1
40200 5113 IF(INP(L).NE.IBLA)GO TO 2113
40300 L=L-1
40400 GO TO 5113
40500 2113 IF(N.EQ.')')GO TO 3361
40600 IF(PARENS.EQ.0)GO TO 1140
40700 LCNT=LCNT+3
40800 IF(MOT.NE.0)GO TO 11403
40900 MOT=LCNT-1
41000 1140 DO 11401 JC=1,LCNT-1,3
41100 IF(INP(L).NE.LIST(JC))GO TO 11401
41200 C FINDS DUPLICATE IDENTIFIER
41300 TYPE 11402,INP(L)
41400 GO TO 99
41500 11403 TYPE 11404
41600 GO TO 99
41700 11404 FORMAT(' MORE THAN 2 PARENS OPEN'/)
41800
41900 11402 FORMAT(' MOTIVIC (',A1,') USED TWICE')
42000 11401 CONTINUE
42100 LIST(LCNT)=INP(L)
42200 PARENS=-1.
42300 INP(L)=IBLA
42400 LIST(LCNT+1)=I
42500 GO TO 236
42600 CC33612 IF(QTS)GO TO 236
42700 CC GO TO 6721
42800 C ''''''' FOR SINGLE QUOTES
42900 3361 IPRN=IPRN+1
43000 CC IF(QTS)GO TO 236
43100 CC GO TO 7231
43200 GO TO 236
43300 C JUMPS BACK INTO QUOTE SECTION
43400 CQ IF(PARENS.EQ.0)GO TO 2140
43500 CQ LIST(LCNT+2)=L
43600 CQ LCNT=LCNT+3
43700 CQ PARENS=0
43800 CQ GO TO 33612
43900 CQ2140 LIST(MOT)=L
44000 CQ GO TO 33612
44100 CQC ))))))))))) LAST ) CAN'T APPEAR AT END OF LINE!!
44200 C @@@@@@@@@@@@ /@Z/DS3/ ETC.
44300 2361 IF(N.NE.'@')GO TO 5361
44400 DO 113 L=1,72
44500 K=JD+L
44600 C K IS USED AT 240!!!
44700 JG=INP(K)
44800 IF(JG.NE.'-')GO TO 6113
44900 RETRO=0
45000 INP(K)=IBLA
45100 GO TO 113
45200 6113 IF(JG.NE.'$')GO TO 7113
45300 C '$' IS FOR INVERSIONS IN 'NOTES'
45400 INVRT=0
45500 GO TO 113
45600 7113 IF(JG.NE.IBLA)GO TO 4113
45700 113 CONTINUE
45800 4113 DO 6361 L=1,LCNT,3
45900 IF(JG.NE.LIST(L))GO TO 6361
46000 VX1=0
46100 DO 40 M=JD+2,72
46200 JG=INP(M)
46300 IF(JG.EQ.IBLA)GO TO 40
46400 IF(JG.EQ.KSLA.OR.JG.EQ.ISEMI.OR.JG.EQ.'*')GO TO 140
46500 ML=M
46600 GO TO 240
46700 40 CONTINUE
46800 240 JC=JA
46900 JA=-1
47000 INP(K)=IBLA
47100 CALL SCANR
47200 JA=JC
47300 140 JC=1
47400 KN=LIST(L+1)
47500 M=LIST(L+2)+1
47600 IF(RETRO)GO TO 640
47700 JC=M-1
47800 M=KN-1
47900 KN=JC
48000 JC=-1
48100 RETRO=-1.
48200 640 IF(INVRT)GO TO 940
48300 840 X=V(KN)
48400 V(I)=X+VX1
48500 C FINDS CENTER FOR INVERSION (+TRANSP.)
48600 I=I+1
48700 KN=KN+JC
48800 IF(V(KN-JC).NE.85.)GO TO 940
48900 V(I-1)=85.
49000 GO TO 840
49100
49200 940 Z=V(KN)
49300 IF(INVRT.EQ.0)GO TO 440
49400 IF(VX1.EQ.0)GO TO 540
49500 C " @Q N " WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
49600 IF(CODE.EQ.-33.)GO TO 440
49700 V(I)=Z*VX1
49800 GO TO 7361
49900 440 IF(Z.EQ.85.)GO TO 540
50000 Y=0
50100 IF(INVRT.EQ.0)Y=(X-Z)*2.
50200 V(I)=Z+VX1+Y
50300 GO TO 7361
50400 540 V(I)=Z
50500 7361 I=I+1
50600 KN=KN+JC
50700 IF(KN.NE.M)GO TO 940
50800
50900 INVRT=-1
51000 RB=V(I-1)
51100 CC ICT=-1
51200 DO 8361 L=JD,72
51300 JG=INP(L)
51400 CC IF(JG.EQ.ISEMI)GO TO 93611
51500 C PUT IN NOV 25, 72
51600 IF(JG.EQ.ISEMI)GO TO 93612
51700 INP(L)=IBLA
51800 IF(JG.EQ.KSLA)GO TO 9361
51900 IF(JG.EQ.')')IPRN=IPRN+1
52000 CC8361 IF(JG.EQ.'*')ICT=0
52100 8361 IF(JG.EQ.'*')IAMP=-1
52200 9361 MLX=L
52300 C FIX THIS & =IBLA BY CHNGING DO LOOP TO 'GO TO' AT 6721,2722
52400 CC IF(ICT.AND.QTS)GO TO 17731
52500 CC↓↓↓↓↓↓↓↓↓↓↓ CHNGD JUNE 24,73 IF(IAMP.EQ.0.AND.QTS)GO TO 17731
52600 IF(IAMP.EQ.0.AND.QTS)GO TO 1773
52700 JZ=-1
52800 CC IF(QTS)GO TO 3013
52900 93612 IF(IAMP.EQ.0)GO TO 93611
53000 CC93612 IF(ICT.EQ.0)IAMP=-1
53100 C NOV 25, 72
53200 IF(QTS)GO TO 3013
53300 GO TO 2722
53400 CC93611 IF(ICT.EQ.0.AND.QTS.EQ.0)GO TO 2722
53500 CC93611 IF(IAMP.AND.QTS.EQ.0)GO TO 2722
53600 C THESE ARE FOR "LIT" ITEMS
53700 C ******* DO NOT USE '@-' OR '@$' WITH 'LIT' ****** ! ! ! !
53800 CC IF(QTS)GO TO 7773
53900 93611 IF(JG.EQ.ISEMI)GO TO 7773
54000 JZ=0
54100 IF(IPRN.NE.0)GO TO 1773
54200 C ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑PICKS UP ' @X)/ ' SITUATION. 22/6/73
54300 GO TO 236
54400 C LAST TIME FOR QUOTES
54500
54600 CC93611 IF(ICT.AND.QTS)GO TO 7773
54700 C********↑↑ ↑↑ WAS TO 6017 JUNE 10,71
54800 CC IF(QTS)GO TO 3013
54900 CC IF(ICT)GO TO 6721
55000 C JUMPS TO END STRING OF QUOTES
55100 6361 CONTINUE
55200 GO TO 99
55300 C @@@@@@@@@@@@@@@@@@@@@@@@@@
55400 5361 IF(N.NE.ID.OR.ISUB.NE.1)GO TO 53611
55500 IF(INP(JD+1).NE.IF)GO TO 236
55600 C JUMP IF NOT DUTY FACTOR
55700 DF=DF-100.
55800 CC GO TO 53611
55900 GO TO 43615
56000 53611 IF(N.NE.ISS.OR.INP(JD+1).NE.'U')GO TO 53612
56100 DF=DF-200
56200 C FOR SUBROUTINE FLAG. CAN'T CALL SUBR AT SAME TIME AS REP OR X!!!!
56300 GO TO 43615
56400 53612 IF(N.NE.IAA)GO TO 43611
56500 C FINDS 'ALL'.
56600 IF(INP(JD+1).NE.'L')GO TO 236
56700 ALL=-1.
56800 CC INP(JD+2)=IBLA
56900 CC53611 INP(JD)=IBLA
57000 CC INP(JD+1)=IBLA
57100 CC GO TO 236
57200 GO TO 43615
57300 C TYPE 'ALL' AFTER PARAM NUM TO PUT DATA IN ALL INSTS.
57400
57500 C QUAD CALL MUST BE IN 1ST OF 5 PARAMS. QUAD MUST BE FOLLOWED
57600 C BY SPC, / OR ;. OTHER CALLS SUCH AS MOVE,NUM ETC. CAN
57700 C APPEAR BEFORE / OR ;, BUT "ALL" MUST! APPEAR
57800 C BEFORE! QUAD (IF USED).
57900 C ADD AN "F" TO QUAD FOR FUNCTIONS, AN "X" FOR X,Y COORDS.
58000 C BASIC QUAD PRODUCES CIRCLES. /DEGS/RADIUS/CENT. X/CENT. Y/
58100 C QUADX -- /X /Y / (5TH PARAM WILL ALWAYS BE WASTED)
58200 43611 IF(N.NE.'Q'.OR.INP(JD+1).NE.'U')GO TO 4361
58300 QX=-13.
58400 DO 43612 N=JD,72
58500 J=INP(N)
58600 IF(J.EQ.IXX)QX=QX-1.
58700 IF(J.EQ.IF)QX=QX-2.
58800 IF(J.EQ.IBLA.OR.J.EQ.KSLA.OR.J.EQ.ISEMI.OR.J.EQ.',')GO TO 236
58900 43612 INP(N)=IBLA
59000 4361 IF(N.NE.'I')GO TO 43613
59100 IF(ISUB.NE.4)GO TO 43613
59200 C NEXT MAKES INST NAME, P1 AND P2 INVISIBLE (REPLACES SEG, ETC.)
59300 INVIS(LK)=-1
59400 43615 DO 43614 L=JD,72
59500 N=INP(L)
59600 IF(N.EQ.IBLA.OR.N.EQ.','.OR.N.EQ.ISEMI.OR.N.EQ.KSLA)GO TO 236
59700 43614 INP(L)=IBLA
59800 43613 IF(N.NE.KSLA)GO TO 636
59900 MLX=JD+1
60000 JZ=-1
60100 INP(JD)=ISEMI
60200 436 IF(INP(MLX).NE.IBLA)GO TO 336
60300 MLX=MLX+1
60400 GO TO 436
60500 636 IF(N.NE.ISEMI)GO TO 936
60600 336 IF(ISUB.EQ.104)GO TO 104
60700 IF(ISUB.GT.3)GO TO 1899
60800 GO TO (101,102,103),ISUB
60900 C PAR MOV LIST OTHERS
61000 936 IF(N.NE.IDOT)GO TO 736
61100 L=INP(JD+1)
61200 DO 836 KL=1,10
61300 836 IF(L.EQ.IDAT(KL))GO TO 236
61400 IF(CODE.EQ.-22.)INP(JD)=1
61500 GO TO 236
61600 C CHANGES DOTTED RHYTHMS TO '1'S.
61700 736 IF(N.NE.'*')GO TO 136
61800 IAMP=-1
61900 INP(JD)=IBLA
62000 C ******* WAS ISEMI ****** WHY?
62100 136 IF(N.NE.IQT)GO TO 236
62200 DO 1361 K=JD+1,72
62300 IF(INP(K).NE.IQT)GO TO 1361
62400 JD=K+1
62500 GO TO 975
62600 C SKIPS MATE∧aP⊂⊂IN QUOTES
62700 1361 CONTINUE
62800 GO TO 99
62900 C OPEN QUOTES
63000 236 JD=JD+1
63100 IF(JD.LT.73)GO TO 975
63200 TYPE 1236
63300 GO TO 99
63400 1236 FORMAT(' MISSING SEMICOLON')
00100 101 N=INP(ML)
00200 IZ=ML
00300 ML=ML+1
00400 IF(N.EQ.IBLA)GO TO 101
00500 C ⊗⊗⊗⊗⊗ MAY 13,71 @@@@@@@@@@
00600 JA=-1
00700 IF(N.EQ.IPP)GO TO 1
00800 IF(N.EQ.IE)GO TO 2308
00900 IF(N.EQ.'R')GO TO 2337
01000 C 'RUN' MAY REPLACE 'END' FOR LAST INST.
01100 IF(N.EQ.ID)GO TO 7720
01200 GO TO 99
01300 1 CALL SCANR
01400 LPAR=VX1
01500 IJ=LPAR
01600 IF(QX.GE.0)GO TO 5703
01700 IJ=LPAR+4
01800 C SETS UP PARAM FOR QUAD CALL
01900 V(I)=IJ+LK*10000
02000 V(I+1)=2*ALL
02100 C TEST "ALL" FEATURE HERE!!!!!!!
02200 C X=-13(DEGREES),=-14(X,Y),=-15(CIRCLE FUNCTS),=-16(LINE FUNCTS)
02300 V(I+2)=QX
02400 I=I+3
02500 QX=0.
02600 5703 IAMP=0
02700 IF(IJ.GT.NP(LK).AND.IJ.LT.31)NP(LK)=IJ
02800 IF(LPAR.EQ.32)LPAR=1
02900 V(I)=LPAR+LK*10000
03000 C +1=WDCNT, +2=CODE, +3='NM' CCCCC
03100 IJ=I+1
03200 I=I+4
03300 ITMP=0
03400 CODE=0
03500 NFLG=1
03600 ML=IZ+M
03700 C RE=REP R=RHY L=LIT M=MOVE MX=MOVX N=NOTES NU=NUM
03800 C S--L=SUBL S--N=SUBN T=TAP RT=RTAP RL=RLIST RN=RNOTES
03900 C QU=QUADC QUX=QUADX
04000 5702 ML=ML+1
04100 IF(ML.GT.72)GO TO 99
04200 N=INP(ML)
04300 IF(N.EQ.IBLA.OR.N.EQ.',')GO TO 5702
04400 NL=INP(ML+1)
04500 JA=-1
04600 ISUB=0
04700 IF(N.EQ.IXX)GO TO 2703
04800 IF(N.EQ.'R')GO TO 6702
04900 IF(N.EQ.IF)GO TO 8702
05000 CC IF(N.EQ.ID)GO TO 1703
05100 4005 JA=0
05200 IF(N.EQ.IEN)GO TO 6005
05300 IF(N.EQ.'M')GO TO 703
05400 IF(N.EQ.'L')GO TO 2720
05500 IF(N.EQ.ISS)GO TO 6703
05600 IF(N.EQ.ITT)GO TO 4018
05700 IF(N.EQ.IQT)GO TO 5720
05800 IF(N.EQ.ISEMI)GO TO 2018
05900 IF(N.EQ.IPP)JA=-1
06000 C FOR /P5 P3/
06100 CALL SCANR
06200 IF(ISUB.EQ.8)GO TO 8
06300 I=I+JJ
06400 V(IJ+1)=NNUM+DF
06500 IF(JJ.EQ.1)GO TO 4006
06600 C IF NNUM IS '-2' THEN NOTES ARE PRINTED
06700 IF(NNUM.NE.-2)GO TO 5006
06800 IX=IJ+3
06900 DO 2006 K=2,JJ,3
07000 CC X=VX(K)
07100 CC Y=VX(K+1)
07200 CC IF(X.GT.Y)VX(K)=X+.999
07300 CC2006 IF(Y.GT.X)VX(K+1)=Y+.999
07400 2006 CALL RANR(VX,K)
07500 C FOR RAN. SELEC. OF NOTES. FINDS HIGHEST NOTE.
07600 5006 IX=IJ+2
07700 DO 6006 K=1,JJ
07800 6006 V(IX+K)=VX(K)
07900 V(IX+JJ-2)=1.
08000 C ABOVE ENSURES THAT LAST RAND. UNIT REACHES 100% - 5/74 *********
08100 GO TO 3013
08200 4006 IF(JA)VX1=VX1/100.+9999.
08300 C CHANGES /P5 P3/ TO /P5 9999.03/
08400 V(I-1)=VX1
08500 GO TO 3013
08600 6702 IF(NL.EQ.IE)GO TO 2703
08700 C JUMP IF "REP"
08800 IF(NL.EQ.ITT)GO TO 4018
08900 C JUMP IF "RTAP"
09000 CODE=-22
09100 IF(NL.EQ.'L')CODE=-46.0
09200 C JUMP IF "RLIST" (LIST OF RAND SELECTIONS)
09300 IF(NL.NE.IEN)GO TO 1016
09400 C JUMP IF NOT "RNOTES"
09500 JA=0
09600 C FOR SCANR
09700 CODE=-36.
09800 GO TO 1016
09900 6005 CODE=-33
10000 IF(NL.NE.'U')GO TO 1016
10100 CODE=-44.
10200 1610 JA=-1
10300 GO TO 1016
10400 8702 CODE=-35
10500 IF(NL.EQ.'U')GO TO 1016
10600 ML=ML+1
10700 CALL SCANR
10800 7 V(IJ+1)=CODE+DF
10900 V(IJ+2)=1.
11000 V(I)=VX1+85.
11100 GO TO 7703
11200 703 BW=V(IJ-2)
11300 IC=0
11400 DO 7031 K=ML+1,72
11500 IF(INP(K).EQ.ISEMI)GO TO 8031
11600 7031 IF(INP(K).EQ.IXX)IC=-1
11700 C**************** JUNE 1,71 X 4
11800 8031 I=I-1
11900 V(I)=0
12000 C ********* FEB. 15,71
12100 X=-9900.-BY
12200 IF(BY.EQ.0)X=-9900.-BG(LK)
12300 IF(BW.EQ.X)GO TO 8005
12400 IF(BW.NE.-9900.-BY)GO TO 1102
12500 V(IJ-2)=X
12600 GO TO 8005
12700 1102 V(IJ)=V(IJ-1)
12800 V(IJ-1)=X
12900 IJ=IJ+1
13000 I=I+1
13100 8005 LP=IJ-1
13200 BW=-9900.-X
13300 ISUB=2
13400 IZ=-1
13500 C ABOVE ARRANGES NECESSARY BG TIME HEADINGS.
13600 4703 GO TO 1299
13700 102 IF(IZ.LT.0)GO TO 2102
13800 BW=V(ICT)+BW
13900 V(I)=-9900.-BW
14000 V(I+1)=V(LP)
14100 V(I+2)=(JJ+2)*ALL
14200 V(I+3)=CODE+DF
14300 I=I+4
14400 IZ=1
14500 2102 IF(BW.LT.10000.)CALL BGSORT(BW)
14600 C ROUND-OFF NONSENSE
14700 2 VX3=-9900.
14800 VX2=VX3
14900 CALL SCANR
15000 IF(JJ.EQ.4)GO TO 99
15100 IF(VX3.NE.-9900.)GO TO 3102
15200 IF(VX2.NE.-9900.)GO TO 4102
15300 VX2=VX1
15400 VX1=10000.
15500 4102 VX3=VX2
15600 JJ=3
15700 C 1,2 OR 3 NUMS CAN BE USED IN NON-RAN MOVES.
15800 3102 IF(IZ.GE.0)GO TO 3006
15900 V(IJ)=(JJ+2)*ALL
16000 C WORD COUNT
16100 CODE=-55.
16200 IF(JJ.NE.3)CODE=-57.
16300 C THIS IS NOW OUT, FEB 15,70. -10000. MEANS 'NOTES AT BG TIME 0'
16400 IF(NFLG)CODE=CODE-1.
16500 IF(IC)CODE=-59.
16600 C**************** JUNE 1,71
16700 C CODE=-56 OR -58 FOR NOTES.
16800 V(IJ+1)=CODE+DF
16900 IZ=0
17000 3006 IF(NFLG.EQ.1)GO TO 5005
17100 CC IF(VX2.GT.VX3)VX2=VX2+.999
17200 CC IF(VX3.GE.VX2)VX3=VX3+.999
17300 CC IF(JJ.EQ.3)GO TO 5005
17400 CC IF(VX4.GT.VX5)VX4=VX4+.999
17500 CC IF(VX5.GE.VX4)VX5=VX5+.999
17600 CALL RANR(VX,2)
17700 IF(JJ.NE.3)CALL RANR(VX,4)
17800 C FOR RAN. SELEC. OF NOTES. FINDS HIGHEST NOTE.
17900 5005 ICT=I
18000 IJ=IJ+1
18100 DO 1006 K=1,JJ
18200 1006 V(IJ+K)=VX(K)
18300 I=I+JJ
18400 IJ=I+2
18500 IF(IAMP.EQ.0)GO TO 1299
18600 C*************** MAY 18,71 ***** ALWAYS RESETS TO TIME 0 WHEN MOVE IS USED.
18700 V(I)=-9900.-BY
18800 GO TO 8703
18900 CC1703 IF(NL.NE.IF)GO TO 4005
19000 CC CODE=-45.
19100 CC GO TO 1016
19200 C ABOVE IS**** WAS ***** FOR 'DF' (DUTY FACTOR)
19300 7703 V(IJ)=4.*ALL
19400 8703 I=I+1
19500 GO TO 4773
19600 C FOR SUBROUTINES, -12=NUMS. -11=LETTERS.
19700 6703 CODE=-12.
19800 IF(INP(ML+3).EQ.'L')CODE=-11.
19900 V(IJ)=2.*ALL
20000 V(IJ+1)=CODE+DF
20100 I=I-1
20200 GO TO 4773
20300 4018 CNT(LK)=-9900.-BY
20400 P(LK)=V(I-4)
20500 JREAD=3
20600 GO TO 4400
20700 C JUMPS TO READER
20800 443 IF(LN.NE.0)REREAD 107,K,IPT(LK,1)
20900 IF(LN.EQ.0)REREAD 8001,IPT(LK,1)
21000 C NAME OF RHYTHM FILE. (ONLY ONE PER INST.) READS DATA JUST BEFORE RUN
21100 IF(NL.NE.ITT)GO TO 2338
21200 CODE=-23.
21300 GO TO 1016
21400 2338 I=I-4
21500 GO TO 4773
21600 3018 CNT(KZY)=-9900.
21700 JREAD=4
21800 GO TO 4400
21900 444 IF(LN.NE.0)REREAD 107,K,IPT(KZY,1)
22000 IF(LN.EQ.0)REREAD 8001,IPT(KZY,1)
22100 P(KZY)=980000.
22200 GO TO 2308
22300 C CAN'T USE 'TAP' OR 'RTAP' WITH INST KZY IF USING 'CONDUCT'.
22400 C 'REP'
22500 2703 ML=ML+1
22600 VX1=0
22700 VX2=0
22800 VX3=0
22900 IF(N.EQ.IXX)GO TO 2704
23000 INP(ML)=IBLA
23100 INP(ML+1)=IBLA
23200 C WIPES OUT 'EP' IN 'REP'
23300 2704 CALL SCANR
23400 V(IJ)=3.
23500 V(IJ+1)=-66.0
23600 IF(VX1.EQ.32.)VX1=1.
23700 IF(VX1.EQ.0)VX1=LPAR
23800 IF(VX2.EQ.0)VX2=LK-1
23900 V(IJ+2)=VX1+VX2*10000.
24000 KL=VX2
24100 IF(DUR(LK).LT.0)DUR(LK)=DUR(KL)
24200 IF(VX3.EQ.0)GO TO 4773
24300 L=VX3
24400 ML=LK+1
24500 DO 1018 KL=ML,L
24600 IF(LPAR.GT.NP(KL).AND.LPAR.LT.31)NP(KL)=LPAR
24700 IF(DUR(KL))DUR(KL)=DUR(LK)
24800 C TO SET DUR WHEN DUPLICATING NOTES THAT END WITH 'END;;'
24900 V(I)=V(I-4)+10000.
25000 V(I+1)=3.
25100 V(I+2)=-66.
25200 V(I+3)=V(I-1)
25300 1018 I=I+4
25400 GO TO 4773
25500
25600 2018 IF(DF.EQ.0)GO TO 20181
25700 C NEXT FOR Pn SUBR/ I.E. NOTHING BUT P AND SUB CALL. 7/73
25800 V(IJ+1)=-201.
25900 V(IJ+2)=1.
26000 V(IJ+3)=0
26100 GO TO 7703
26200 20181 V(IJ)=3.
26300 V(IJ+1)=-66.
26400 V(IJ+2)=NW+LK*10000
26500 GO TO 4773
26600 C READS /P5 .3 "ABC" .7 "XYZ"/
26700
26800 8 V(IJ+1)=-77.+DF
26900 C DF HAS SUBR CALL INFO
27000 I=I+1
27100 VX(JJ-1)=1
27200 C FOR RAND. SINGLE LITS.
27300 DO 3722 K=1,JJ,2
27400 V(I)=VX(K)
27500 3722 I=I+1
27600 V(IJ+2)=JJ/2
27700 V(IJ+3)=I
27800 DO 4722 K=2,JJ,2
27900 KN=I
28000 I=I+1
28100 L=VX(K)
28200 DO 6722 KL=L,72
28300 IF(INP(KL).EQ.IQT)GO TO 4722
28400 IV(I)=INP(KL)
28500 6722 I=I+1
28600 4722 V(KN)=I-KN-1
28700 V(IJ)=(I-IJ)*ALL
28800 GO TO 4773
28900 2720 QTS=0
29000 ISUB=104
29100 GO TO 1299
29200
29300 104 DO 6721 K=ML,72
29400 JC=K+1
29500 IF(INP(K).EQ.IQT)GO TO 7721
29600 6721 IF(INP(K).EQ.KSLA.OR.INP(K).EQ.ISEMI)GO TO 7232
29700 C FOR REPEAT OF ITEM BY SLASH
29800 7232 DO 7231 K=I-1,1,-1
29900 IF(ABS(V(K)).GT.72.)GO TO 7231
30000 NL=V(K)
30100 DO 7230 KL=K,K+NL
30200 V(I)=V(KL)
30300 7230 I=I+1
30400 GO TO 27222
30500 7231 CONTINUE
30600
30700 5720 IAMP=-1
30800 JC=ML+1
30900 C FOR SINGLE 'LIT' ITEMS.
31000 7721 DO 1722 KL=JC+1,72
31100 IF(INP(KL).NE.IQT)GO TO 1722
31200 JD=KL-1
31300 ML=KL+1
31400 NL=KL-JC
31500 C EXTENT OF LIT ITEM IS FOUND
31600 GO TO 8721
31700 1722 CONTINUE
31800 C CAN'T USE SLASH FOR REPEAT AFTER @Q
31900 8721 V(I)=NL
32000 DO 9721 K=JC,JD
32100 C PUTS ITEM IN "IV" ARRAY
32200 I=I+1
32300 9721 IV(I)=INP(K)
32400 I=I+1
32500 27222 IF(IAMP.EQ.0)GO TO 1299
32600 2722 V(I)=999.
32700 QTS=-1.
32800 27221 V(IJ+1)=-88.+DF
32900 V(IJ)=(I-IJ+1)*ALL
33000 IJ=IJ+2
33100 V(IJ)=IJ+1
33200 I=I+1
33300 ISUB=1
33400 GO TO 1299
33500
33600 7720 V(I)=LK
33700 V(I+1)=3.
33800 V(I+2)=-67.
33900 ML=ML+4
34000 CALL SCANR
34100 V(I+3)=VX1
34200 I=I+4
34300 L=VX1
34400 IF(NP(LK).LT.NP(L))NP(LK)=NP(L)
34500 IF(DUR(LK).LT.0)DUR(LK)=DUR(L)
34600 GO TO 4773
34700 C TYPE 'DUPL N;' N=INST # TO BE DUPLICATED.
34800 142 FORMAT(I,15A5)
34900 1301 FORMAT(15A5)
35000 2773 FORMAT(I,A5,72A1)
35100 2114 FORMAT(I,72A1)
35200 300 FORMAT(I,3F,A1)
35300 301 FORMAT(3F,A1)
35400 6 KB=KB+1
35500 IF(JED.GT.0)JED=0
35600 IF(J.EQ.'INSER')GO TO 1340
35700 OTH(KB,1)=VX1*100000.+VX2*100.+VX3
35800 GO TO 340
35900 1340 X=VX1
36000 IF(VX2.NE.0)X=1000000.+VX1*100000.+VX2
36100 OTH(KB,1)=X
36200 GO TO 1338
36300 C ABOVE IS TO PUT INSERT AFTER NOTE # OF A PARTICULAR
36400 C INSTRUMENT. FOR COMMENT AT START, SET BG TIME TO 1,1
36500 C - BEGIN LINE WITH <,END WITH ;
36600 C UP TO 75 CHARACTERS MAY BE TYPED.
36700 340 IF(VX3.NE.2)GO TO 1338
36800 IF(ITYP.GE.0)GO TO 449
36900 JREAD=5
37000 GO TO 4400
37100 445 OTH(KB,3)=1.
37200 IF(LN.EQ.0)GO TO 447
37300 REREAD 300,K,OTH(KB,2)
37400 GO TO 1447
37500 447 REREAD 301,OTH(KB,2)
37600 1447 IF(JED)GO TO 2308
37700 3445 TYPE TEDIT
37800 ACCEPT 77732,K
37900 IF(K.EQ.'G')JED=-1
38000 IF(J.EQ.'INSER')GO TO 3446
38100 IF(K.NE.'Y'.OR.JED)GO TO 2308
38200 449 TYPE TPALN
38300 ACCEPT 301,OTH(KB,2)
38400 IF(JED)WRITE(21,301) OTH(KB,2)
38500 GO TO 2308
38600
38700 1338 IF(ITYP.GE.0)GO TO 1449
38800 JREAD=6
38900 GO TO 4400
39000 446 IF(LN.EQ.0)GO TO 448
39100 REREAD 142,K,(OTH(KB,JD),JD=2,16)
39200 GO TO 1446
39300 448 REREAD 1301,(OTH(KB,JD),JD=2,16)
39400 1446 IF(JED)2446,3445,2446
39500 3446 IF(K.NE.'Y'.OR.JED)GO TO 2446
39600 1449 TYPE TPALN
39700 ACCEPT 1301,(OTH(KB,JD),JD=2,16)
39800 IF(JED)WRITE(21,1301)(OTH(KB,JD),JD=2,16)
39900 2446 X=OTH(KB,2)
40000 IF(J.EQ.'INSER'.AND.VX3.NE.0.AND.X.NE.'*')GO TO 6
40100 IF(X.EQ.'*')KB=KB-1
40200 C ALLOWS SEVERAL LINES OF 'INSERT' IF ANY 3RD #.
40300 C LAST LINE HAS '*' IN COLUMN 1.
40400 GO TO 2308
40500 C IF NO PARAM NUM IS GIVEN, ALL PARAMS MUST BE TYPED.
40600 C INSERT MAY INCLUDE 10 CHARS(P3-P30),
40700 C P2, A # ONLY. IF MORE THAN 1 PARAM IS TO BE EDITED AND
40800 C P2 IS ONE OF THEM, FIRST EDIT P2 TO DESIRED VALUE,
40900 C CHANGE P2 TO MINUS = THEN INSERT ENTIRE NOTE TO PLAY
41000 C JUST AFTER ORIGINAL NOTE(WHICH WILL BE A REST).
41100 C BX=INST N. Y=NOTE N. Z=PARAM N.
41200 1899 CALL SCANR
41300 GO TO(1,2,3,4,5,6),ISUB
00100 1106 KTMP=1
00200 TP=60.
00300 IAMP=0
00400 BW=BY
00500 ITMP=-1
00600 ISUB=5
00700 JA=-1
00800 GO TO 2016
00900 3019 V(I)=990000.00
01000 V(I+1)=4.
01100 V(I+2)=VX1
01200 V(I+3)=VX2/TP
01300 V(I+4)=VX3/TP
01400 I=I+5
01500 BY=BW
01600 C SEPT 18, 70
01700 IF(VX1.EQ.0)GO TO 2308
01800 BW=BW+VX1
01900 V(I)=-9900.-BW
02000 I=I+1
02100 CALL BGSORT(BW)
02200 9003 IF(IAMP)GO TO 4003
02300 2016 VX3=0
02400 VX2=0
02500 GO TO 1299
02600 5 IF(VX2.NE.0)GO TO 105
02700 C 'TEMPO/120*;' OR 'TEMPO/1.5 72*;' IS OK.
02800 VX2=VX1
02900 VX1=0
03000 105 IF(VX3.EQ.0)VX3=VX2
03100 IF(VX2.LT.11.)TP=1.
03200 IF(J.EQ.ITMPO)GO TO 3019
03300 PCH(1,KTMP)=VX1
03400 PCH(2,KTMP)=VX2
03500 PCH(3,KTMP)=VX3
03600 C PCH(1)=TIME (2)=MM1 (3)=MM2
03700 KTMP=KTMP+1
03800 IF(IAMP.EQ.0)GO TO 2016
03900 4003 VX1=0
04000 IAMP=0
04100 VX2=VX3
04200 IF(J.EQ.ITMPO)GO TO 3019
04300 PCH(1,KTMP)=0
04400 PCH(2,KTMP)=VX2
04500 PCH(3,KTMP)=VX2
04600 C MM CAN BE FROM 11 UP ITMPO FACTOR FROM 10 DOWN.
04700 C UP TO 30 ITMPO CHANGES MAY BE MADE.
04800
04900 1016 IA=I
05000 IZ=1
05100 3100 V(I-2)=CODE+DF
05200 ISUB=3
05300 5016 IF(IAMP.GE.0)GO TO 1299
05400 117 IF(IZ-2)3013,9004,9004
05500 103 K=INP(ML)
05600 IF(K.EQ.ITT)GO TO 1106
05700 IF(K.EQ.ISEMI)GO TO 1014
05800 IF(K.NE.IBLA) GO TO 1899
05900 ML=ML+1
06000 GO TO 103
06100 C@@@@@@@@ MAY 13,71 @@@@@@
06200 C**********FEB 19,71
06300 C ABOVE
06400 3 IF(VX1.EQ.-99.)GO TO 4022
06500 IF(CODE.EQ.-22.)GO TO 2017
06600 C************ MAY 19,71
06700 IF(CODE.LT.-23.OR.IZ/2*2.EQ.IZ)GO TO 17
06800 C CHECKS PAIRS OF NUMBERS FOR 'RTAP'
06900 2017 IF(VX1.EQ.10000.)GO TO 17
07000 VX1=4./VX1
07100 IF(JJ.NE.1)GO TO 2014
07200 V(I)=VX1
07300 GO TO 114
07400
07500 1217 IF(VX1.EQ.10000.)GO TO 114
07600 C FOR "FINE" IN LIST
07700 CC IF(CODE.EQ.-46.)GO TO 4217
07800 CC IF(VX1.GT.VX2)V(I)=VX1+.999
07900 CC IF(VX2.GT.VX1)VX2=VX2+.999
08000 C ABOVE EXTENDS RANGE TO GIVE HIGHEST NOTE A CHANCE
08100 CC4217 V(I+1)=VX2
08200 V(I+1)=VX2
08300 IF(CODE.EQ.-36.)CALL RANR(V,I)
08400 2217 I=I+1
08500 C SETS UP STRING OF RAND SELECTIONS
08600 GO TO 114
08700 3217 V(I)=V(I-2)
08800 V(I+1)=RB
08900 C FOR SLASH REPTS OF RAND SELEC UNITS. ("REP" CAN'T BE USED!)
09000 GO TO 2217
09100 C******** PUT IN ERROR TRAP FOR "REP" ETC. ******
09200
09300 2014 DO 9006 L=2,JJ
09400 IF(VX(L).EQ.0)GO TO 17
09500 9006 VX1=4./VX(L)+VX1
09600 JJ=1
09700 17 V(I)=VX1
09800 IF(CODE.EQ.-46..OR.CODE.EQ.-36.)GO TO 1217
09900 C JUMP IF STRING OF RAND SELECS.
10000 IF(JJ.EQ.1)GO TO 114
10100 L=VX(JJ)-1
10200 X=V(I)
10300 NL=I+1
10400 I=L+I
10500 DO 1017 K=NL,I
10600 1017 V(K)=X
10700 C ADDS UP TOTAL OF NOTES IN SEQ.
10800 IZ=IZ+L
10900 GO TO 114
11000 1014 IF(CODE.EQ.-46..OR.CODE.EQ.-36.)GO TO 3217
11100 V(I)=RB
11200 C RB SAVES IT FOR SLASH REPEAT
11300 114 RB=V(I)
11400 I=I+1
11500 IZ=IZ+1
11600 GO TO 5016
11700 4022 JC=VX2+.3
11800 JD=VX3-.5
11900 IF(JJ.EQ.2)JD=1
12000 C********* MAY 19,71 ----MANY LINES ABOVE.
12100 IZ=IZ+JC*JD
12200 C JC=HOW MANY TIMES, JD=HOW MANY NOTES
12300 DO 1005 K=1,JD
12400 NL=I+JC-1
12500 DO 2005 L=I,NL
12600 2005 V(L)=V(L-JC)
12700 1005 I=I+JC
12800 RB=V(NL)
12900 C RB SAVES DATA FOR SLASH REPEAT FEATURE.
13000 GO TO 5016
13100
13200 9004 IF(ITMP.EQ.0)GO TO 3013
13300 C*********** JUNE 1,71
13400 IZ=IZ-1
13500 C***** JAN. 1974
13600 KA=1
13700 IC=1
13800 K=0
13900 J=1
14000 Z=0
14100 RC=0
14200 9007 Y=PCH(3,IC)/TP
14300 X=PCH(2,IC)/TP
14400 Z=PCH(1,IC)
14500 CALL SQYY(YY,X,Y,Z)
14600 XT(1)=X
14700 XA=RA
14800 RD=1
14900 RB=0
15000 ZZ=Z
15100 7020 RA=V(IA+K)
15200 IF(RA.EQ.10000.)GO TO 3013
15300 4020 RD=1
15400 IF(RA.LT.0)RD=-1.
15500 RA=RA*RD
15600 IF(KA.EQ.0)RA=RA-RC
15700 W=RA
15800 RB=W
15900 IF(W.LE.Z)GO TO 2020
16000 IF(Z.NE.0)GO TO 3020
16100 RA=RA/Y
16200 RB=-1.
16300 RC=0
16400 GO TO 8020
16500 3020 W=Z
16600 RC=W+RC
16700 GO TO 24
16800 2020 RC=0
16900 24 IF(X.NE.Y)GO TO 424
17000 RA=W/X
17100 GO TO 8020
17200 C DUR OF TMP + BG TIME OF TMP - NOTE VALUE -
17300 C BG TIME OF NOTE. CHN=TBG.
17400 424 RAX=XT(J)
17500 RA=(-2.*RAX+(4.*RAX**2+8.*YY*W)**.5)/(2.*YY)
17600 XT(J)=RAX+YY*RA
17700 8020 IF(KA.EQ.0)RA=RA+XA
17800 KA=1
17900 IF(RC.NE.0)GO TO 1011
18000 IF(T5.EQ.1)GO TO 8203
18100 V(IA+K)=RA*RD
18200 IF(K.EQ.IZ)GO TO 3013
18300 C*********** JUNE 1,71
18400 1011 IF(T5.EQ.1)GO TO 2011
18500 K=K+1
18600 IF(ZZ.NE.0)Z=Z-W
18700 IF((Z.GT.0).OR.(RB.EQ.-1.))GO TO 7020
18800 IC=IC+1
18900 IF(RB.EQ.W)GO TO 9007
19000 KA=0
19100 K=K-1
19200 GO TO 9007
19300 C********* MAY 13,71 OMITS REPEATED RHY. FEATURE.
19400 C ML=I-1
19500 C ML=I-1
19600 C*********** MAY 13,71 ********
19700 3013 X=I-IJ
19800 V(IJ+2)=X-3.
19900 V(IJ)=X*ALL
20000 IF(CODE.NE.-35)GO TO 4773
20100 M=IJ+3
20200 C SETS NUMBERS FOR FUNCS.
20300 DO 313 K=M,I-1
20400 313 IF(V(K).LT.85.)V(K)=V(K)+85.
20500 GO TO 4773
20600
20700 2011 XA=RA
20800 IF(K.GT.1)GO TO 9020
20900 K=I-6
21000 ZPAR=-9900.-CHN-ZZ
21100 DO 3011 KL=8,I
21200 IF((V(K).EQ.ZPAR).AND.(V(K+1).EQ.990000.))GO TO 9020
21300 3011 K=K-1
21400 9020 W=ZZ
21500 IF(V(K+3))K=K+3
21600 C ABOVE IS FOR TYPED IN TEMPO CHANGES
21700 KA=K+3
21800 ZZ=V(KA)
21900 C DUR OF NEXT TEMPI
22000 X=V(KA+1)
22100 Y=V(KA+2)
22200 213 KA=0
22300 Z=ZZ
22400 CALL SQYY(YY,X,Y,Z)
22500 CHN=CHN+W
22600 XT(J)=X
22700 IF(KA.EQ.1)Z=0
22800 RA=PR
22900 KA=0
23000 K=K+3
23100 GO TO 4020
00100 2337 T=0
00200 DO 1107 K=1,30
00300 1107 PL(K)=1.
00400 C 2/74--WAS AT 17300/1 SETS DEFAULT OUTPUT MODE TO 1.
00500 IF(ITYP)GO TO 23371
00600 END FILE 21
00700 DATA ENFI /25H(' INPUT ON FOR21.DAT'/) /
00800 TYPE ENFI
00900 C PUTS AWAY TYPED IN DATA. TO REUSE, EDIT FOR21.DAT.
01000 23371 IF(SOS)WRITE(JOUT,902)
01100 C WRITES A BLANK LINE
01200 NWZZ=0
01300 IAMP=0
01400 IT3=0
01500 K=1
01600 IX=0
01700 BG(NINS+1)=19999.
01800 4011 IF(CNT(K))GO TO 5011
01900 6011 IF(K.EQ.KZY)GO TO 4337
02000 K=K+1
02100 GO TO 4011
02200 5011 L=V(I-1)/(-9900.)
02300 IF(L.EQ.1)I=I-1
02400 V(I)=CNT(K)
02500 V(I+1)=P(K)
02600 V(I+3)=-44.
02700 I=I+5
02800 IF(P(K).EQ.980000.)I=I-4
02900 KL=I
03000 REWIND 1
03100 ICT=IPT(K,1)
03200 CALL IFILE(1,ICT)
03300 9011 L=I+6
03400 READ(1,7011)(V(M),M=I,L)
03500 C READS "CONDUCT" AND "RHYTHM" (TAP) DATA.
03600 IF(V(L).EQ.999.)GO TO 8011
03700 I=L+1
03800 GO TO 9011
03900 8011 IF(P(K).NE.980000.)GO TO 6337
04000 DO 7337 K=L,I,-1
04100 7337 IF(V(K).NE.999.)GO TO 8337
04200 8337 I=K-1
04300 V(I)=0
04400 V(I+1)=V(K)
04500 V(I+2)=V(K)
04600 C K WAS I-1 ABOVE.
04700 I=I+3
04800 V(KL+1)=I-KL-1
04900 C ABOVE RESETS WORDCOUNT FOR 'CONDUCT' DATA.
05000 GO TO 4337
05100 6337 DO 5337 M=I,L
05200 KN=M
05300 5337 IF(V(M).EQ.999.)GO TO 3337
05400 3337 I=KN
05500 KN=I-KL
05600 V(KL-1)=KN
05700 V(KL-3)=KN+3
05800 GO TO 6011
05900 7011 FORMAT(7F)
06000 4337 IF(V(I-1).EQ.-9900.-BY)I=I-1
06100 V(I)=-19899.
06200 PP1=0
06300 T6=10000.
06400 DO 2118 K=1,NINS
06500 ROFF(K)=0
06600 C********* FEB 17,71
06700 M=NP(K)
06800 IT(K)=0
06900 IPT(K,31)=0
07000 NCNT(K,31)=1
07100 DO 2118 L=1,M
07200 NCNT(K,L)=1
07300 2118 IPT(K,L)=0
07400 DO 5013 K=1,IXIN
07500 5013 X=RAND(0.0,0.0)
07600 REWIND 1
07700 IF(MX)CALL OFILE(1,ISLAC)
07800 NW=1
07900 NWX=0
08000 TDUR=0
08100 A=0
08200 T2=1.
08300 T4=1.
08400 T5=0
08500 J=1
08600 MK=0
08700 C IS THE ABOVE NEEDED?
08800 IF(MX.NE.3)GO TO 40021
08900 K=4
09000 CC10023 N=V(K)/-11.
09100 10023 N=AMOD(V(K),100.0)/-11.
09200 C AMOD NEEDED BECAUSE CODE # MAY HAVE -100 FOR DF OR -200 FOR SUBR.
09300 IF((N.NE.2.AND.N.NE.3.AND.N.NE.4).OR
09400 1 .V(K-2).LT.10000.)GO TO 10021
09500 J=V(K+1)
09600 IF(J.EQ.1)GO TO 10024
09700 IF(N.EQ.3.AND.V(K+J+1).EQ.101.)J=J-1
09800 N=V(K-2)
09900 L=N/10000
10000 M=N-L*10000
10100 TYPE 10022,INST(L),M,J
10200 10024 K=K+ABS(V(K-1))
10300 10021 K=K+1
10400 IF(K.LT.I)GO TO 10023
10500 40021 IF(MZ.NE.-4)GO TO 1002
10600 N=1
10700 40022 K=N+1
10800 IF(N.GT.I)CALL EXIT
10900 X=V(N)
11000 IF(X.EQ.-199..OR.X.EQ.-99.)GO TO 40024
11100 IF(X.GE.0)GO TO 40023
11200 PRINT 4002,X
11300 N=N+1
11400 GO TO 40022
11500 40024 J=N+1
11600 GO TO 40025
11700 C FOR 'SECTIONS'
11800 40023 J=ABS(V(K))+K-1
11900 40025 PRINT 4002,(V(K),K=N,J)
12000 N=J+1
12100 GO TO 40022
12200 10022 FORMAT(1XA5,' P',I2,' HAS ',I3,' ITEMS.')
12300 4002 FORMAT(10F12.3)
12400 1002 IF(IDALL)GO TO 600
12500 X=DUR(IDALL)
12600 DO 2002 K=1,NINS
12700 2002 IF(DUR(K))DUR(K)=X
00100 C ***** SORTER *************************
00200 C ******* OUTPUT LOOP FROM HERE ON ********
00300 600 IL=0
00400 C********** BELOW IS FOR 'SECTIONS'
00500 KODE=0
00600 NWX=NWX+1
00700 MK=MK+1
00800 Y=BNW(NW)
00900 723 IL=IL+1
01000 3723 Z=V(IL)
01100 IF(Z.EQ.-19899.)GO TO 732
01200 IF(Z.NE.-9900.-Y)GO TO 723
01300 C********** BELOW IS FOR 'SECTIONS'
01400 IF(V(IL-2).EQ.-199.)KODE=IV(IL-1)
01500 2723 IL=IL+1
01600 729 K=IL+2
01700 MOT=V(IL+1)
01800 RD=V(K)
01900 IF(RD.EQ.-67.)GO TO 3726
02000 RB=V(IL)
02100 C************ DOWN TO 4150 IS FOR 'SECTIONS'
02200 IF(RB.NE.-99.)GO TO 4150
02300 KODE=IV(K-1)
02400 2160 IF(KODE.EQ.0)GO TO 723
02500 IF(MZ)WRITE(JOUT,9150),KODE
02600 KL=Y/10000.
02700 RB=Y+KL*10000.
02800 DO 5150 KL=1,I
02900 IF(V(KL).NE.-199..OR.IV(KL+1).NE.KODE)GO TO 5150
03000 IV(K-1)=0
03100 C WHEN 'PLAY' HAS BEEN FOUND, INDENTIFIER CHNGED TO 0
03200 RD=V(KL+2)+9900.
03300 DO 6150 L=KL+2,I
03400 M=V(L)/(-9900.)
03500 IF(M.NE.1)GO TO 6150
03600 RA=RB+RD-V(L)-9900.
03700 V(L)=-9900.-RA
03800 C UPDATES BG TIMES INSIDE SECTION.
03900 CALL BGSORT(RA)
04000 C7150 IF(RA.EQ.BNW(KA))GO TO 6150
04100 C UPDATES LIST OF CHANGE TIMES.
04200 6150 IF(V(L).EQ.-299.)GO TO 160
04300 5150 CONTINUE
04400 160 IL=1
04500 GO TO 3723
04600 C*********** ABOVE IS FOR 'SECTION' REPEATS
04700 4150 LK=RB/10000.+.2
04800 IF(LK.GE.98)GO TO 7700
04900 LP=RB-LK*10000
05000 C LK=INST # LP=PARAM #
05100 LN=IPT(LK,LP)
05200 IPT(LK,LP)=IL+2
05300 IF(RD.EQ.-66.)GO TO 726
05400 IF(RD.EQ.-55..OR.RD.EQ.-56.)GO TO 1726
05500 IF(RD.EQ.-23)GO TO 6700
05600
05700 2727 ML=IPT(LK,LP)
05800 IF(MOT.GT.0)GO TO 3727
05900 C USE NEG WDCNT FOR 'ALL'
06000 DO 4727 KL=LK+1,NINS
06100 IF(NP(KL).LT.LP.AND.LP.LT.31)NP(KL)=LP
06200 IPT(KL,LP)=-(LK+(LP-1)*KZY)
06300 NCNT(KL,LP)=10000
06400 4727 IF(DUR(KL))DUR(KL)=1000.
06500 C ASSUMES THAT DURATIONS ARE SET IN 'NOTES'.
06600 C AFTER 'ALL' IS USED ONCE IT WORKS LIKE DUPL OR REP.
06700 CC GO TO 2150
06800 C ABOVE CHANGED TO BELOW DEC.6,72. 'ALL' WAS OMITTING 1ST ITEM.
06900 GO TO 727
07000 C 'MOVE' WITH 'ALL' KEEPS ORIGINAL TIME DATA REGARDLESS OF BG TIMES.
07100 3727 IF(V(IL).NE.V(LN-1).OR.LN.EQ.0)GO TO 727
07200 CC ************ JAN 20 ***********
07300 DO 1727 L=1,NINS
07400 DO 1727 KL=1,NP(L)
07500 IF(LN.NE.IPT(L,KL))GO TO 1727
07600 NCNT(L,KL)=10000
07700 C ******* JAN 29,70
07800 IPT(L,KL)=ML
07900 C RESETS POINTERS FOR DUPL AND REP INSTS.
08000 C *** 'ALL' WILL NOT WORK WITH RAN TF.!!!!!*******FEB 21,73
08100 1727 CONTINUE
08200 727 NCNT(LK,LP)=10000
08300 C******** MAY 13,71 RHY REP. FEATURE OMITTED.
08400 2150 IF(MOT)MOT=-MOT
08500 IL=IL+MOT+1
08600 3150 IF(V(IL))GO TO 3723
08700 GO TO 729
08800 726 RB=V(IL+3)
08900 K=RB/10000.
09000 L=RB-K*10000
09100 IPT(LK,LP)=-(K+(L-1)*KZY)
09200 GO TO 2727
09300 3726 LK=V(IL)
09400 M=V(K+1)
09500 KL=NP(M)
09600 DO 4726 L=1,KL
09700 IPT(LK,L)=IPT(M,L)
09800 IF(IPT(M,L).NE.0)NCNT(LK,L)=10000
09900 C****** JUN 29 71 (LK,L) WAS (L,K)....???????
10000 4726 CONTINUE
10100 IPT(LK,31)=IPT(M,31)
10200 K=0
10300 GO TO 2150
10400 C ABOVE IS FOR DUPLICATION ROUTINE NEXT ADJUSTS TIMES FOR 'RTAP'
10500 6700 KL=IL+V(IL+1)+1.3
10600 RC=V(K-2)
10700 1770 IF(V(KL))GO TO 700
10800 2700 KL=KL+V(KL+1)+1.3
10900 GO TO 1770
11000 700 KL=KL+1
11100 IF(Z.NE.V(KL-1).OR.V(KL).NE.RC)GO TO 2700
11200 KL=KL+3
11300 KN=IL+3
11400 LN=V(KN)+.3
11500 DO 3700 L=1,LN,2
11600 RA=V(L+KN)
11700 KA=V(L+KN+1)+.3
11800 RB=0
11900 DO 4700 LP=1,KA
12000 4700 RB=RB+V(KL+LP)
12100 DO 5700 LP=1,KA
12200 5700 V(KL+LP)=V(KL+LP)/RB*RA
12300 V(KL+KA)=V(KL+KA)+.00030
12400 3700 KL=KL+KA
12500 GO TO 2150
12600
12700 C BELOW FOR 'TEMPO' SETUP
12800 7700 T2=V(IL+4)
12900 T1=V(IL+3)
13000 TBG=Y
13100 TDUR=V(IL+2)
13200 CC AC=2.*TDUR/(T1+T2)
13300 CC AC=2.*(TDUR-T1*AC)/AC**2
13400 CALL SQYY(AC,T1,T2,TDUR)
13500 8700 IF(TDUR.EQ.0)TDUR=10000.
13600 T5=1.
13700 T6=TBG+TDUR
13800 IT3=1.
13900 IF(LK.EQ.98)IT3=IL+2
14000 T4=1.
14100 GO TO 2150
14200 C*************** ANY WDCNTS DOWN FROM HERE. *********
14300 C NEXT ADJUSTS 'MOVE' TIMES IF BG IS AT A NOTE NUMBER.
14400 1726 IF(V(IL-1).GT.-19000.)GO TO 2727
14500 RA=BT
14600 K=IL-1
14700 2726 V(K)=-9900.-RA
14800 ISUB=-1
14900 L=K+5
15000 RB=V(L)+V(L-1)
15100 V(L-1)=RA
15200 K=K+V(K+2)+2
15300 IF(V(K).GT.-19000..OR.V(K+1).NE.V(IL).OR.
15400 1 V(K).NE.-9900.-RB)GO TO 2727
15500 RA=RA+V(L)
15600 CALL BGSORT(RA)
15700 GO TO 2726
15800 C CONVERTS BG TIME OF NOTE NUM TO REAL TIME. DOESN'T WORK WITH -66!
15900 C NOW WE BEGIN ON!! NOTE NUM. NOT AFTER NOTE NUM.
16000 732 DO 2606 K=NW,NWZ
16100 2606 BNW(K)=BNW(K+1)
16200 NWZ=NWZ-1
16300 IF(NWZ.EQ.0)GO TO 2111
16400 IF(NWZZ.EQ.1)GO TO 5111
16500 NWZZ=1
16600 IF(NWZ.EQ.1)GO TO 1111
16700 DO 3111 K=1,NWZ
16800 IF(BNW(K).LT.1000.)GO TO 3111
16900 X=BNW(NWZZ)
17000 BNW(NWZZ)=BNW(K)
17100 BNW(K)=X
17200 NWZZ=NWZZ+1
17300 3111 CONTINUE
17400 5111 IF(NWZZ.EQ.NWZ)GO TO 1111
17500 L=NWZZ+1
17600 X=BNW(NWZZ)
17700 DO 4111 K=L,NWZ
17800 IF(BNW(K).GT.X)GO TO 4111
17900 RA=BNW(K)
18000 BNW(K)=X
18100 X=RA
18200 4111 CONTINUE
18300 BNW(NWZZ)=X
18400 GO TO 1111
18500 111 FORMAT(1XA5,'.DAT',12X,'EDIT FILE NAME=',A5,8X,
18600 1'V ARRAY=',I4,'/2000 TEMPO FACTOR=',F6.2,4X,
18700 1'RANDOM NUMBER =',I6/)
18800 1023 FORMAT(/' < ',A5,'.DAT '/1XA5)
18900 C********** BELOW IS FOR 'SECTIONS'
19000 9150 FORMAT(/3X'******* SECTION ',A1)
19100 2111 NWZ=-1
19200 C ABOVE ORDERS BNW DATA TO SAVE TIME AT 1108 ON PG5.
19300 1111 IF(MZ.EQ.0)GO TO 1601
19400 IF(NWX.NE.1)GO TO 1486
19500 WRITE(JOUT,111),ISLAC,IFLNM,I,TF,IXIN
19600 C*********** JUNE 1,71
19700 C********** BELOW IS FOR 'SECTIONS'
19800 1486 IF(KODE.NE.0)WRITE(JOUT,9150),KODE
19900 K=NWX-1
20000 C*********** JUNE 1,71
20100 IF(NWX.GT.1.AND.IT(J).NE.-3)WRITE(JOUT,3154),K,Y
20200 IF(IT(J).EQ.-3)WRITE(JOUT,5154),K,BX,INST(J)
20300 C*********** JUNE 1,71 X 3 K'S
20400
20500 DO 602 K=1,NINS
20600 48 LK=INST(K)
20700 C*********** JUNE 1,71
20800 IF(NCNT(K,31).NE.10000.AND.NWX.GT.1)GO TO 602
20900 CCNOV,72 IF(NCNT(K,31).NE.10000.AND.NWX.GT.1)GO TO 8826
21000 NCNT(K,31)=1
21100 IJ=IPT(K,31)
21200 X=0
21300 IF(IJ.NE.0)X=V(IJ+2)
21400 WRITE(JOUT,5396),LK,X
21500 X=DUR(K)
21600 IF(X.GT.10000.)GO TO 83
21700 WRITE(JOUT,8396),X
21800 CCNOV,72 GO TO 8826
21900 GO TO 602
22000 5396 FORMAT(5XA5,' RANDOM TF =',F4.2,10X,'DURATION =',$)
22100 7396 FORMAT('+',F5.0,' NOTES')
22200 CCNOV,72
22300 CC4396 FORMAT(5XA5,' % RANDOM RESTS DUR=',F7.3,'", FROM',
22400 CC 1F6.3,' TO',F6.3)
22500 CC485 FORMAT(5XA5,' % RANDOM RESTS = ',F4.2)
22600 CCNOV,72
22700 8396 FORMAT('+',F6.2,'"')
22800 83 X=X-10000.
22900 WRITE(JOUT,7396),X
23000 CCNOV,72 *************************************************
23100 CC8826 IF(NCNT(K,1).NE.10000)GO TO 602
23200 CC NCNT(K,1)=1
23300 CC IJ=IPT(K,1)+2
23400 C********* FEB 19,71
23500 CC IF(V(IJ)-5.)GO TO 7826
23600 CC WRITE(JOUT,4396),LK,V(IJ-1),V(IJ),V(IJ+1)
23700 C********* FEB 19,71
23800 CC GO TO 602
23900 CC7826 WRITE(JOUT,485),LK,V(IJ)
24000 CCNOV,72 *************************************************
24100 602 CONTINUE
24200 715 IF(IT3.NE.1.)GO TO 1602
24300 RA=T1*TP
24400 RB=T2*TP
24500 WRITE(JOUT,6154),RA,RB,TDUR
24600 IT3=0
24700 1602 IF(NWX.EQ.1)GO TO 315
24800 IF(IT(J).EQ.-3)GO TO 1108
24900 C*********** JUNE 1,71
25000 6154 FORMAT(' TMP=',F7.3,' TO',F8.3,' DURING',F6.2,' SECS.'/)
25100 7154 FORMAT(' ''CONDUCT'' FILE NAME = ',A5/)
25200 5154 FORMAT(/' << CHANGE',I3,' BEGINS ON NOTE',F5.0,1XA5,' >>'/)
25300 902 FORMAT(1XA5/)
25400 3154 FORMAT(/' << BASIC TIME OF CHANGE',I3,' IS',F8.3,'" >>'/)
25500 4154 FORMAT(' THE FIRST',F9.4,'" ARE OMITTED'/)
25600 C*********** JUNE 1,71
25700 IT(J)=IT(J)/10
25800 GO TO 1108
25900 315 IF(IT3.GT.1)WRITE(JOUT,7154),ICT
26000 IF(OP1.NE.0)WRITE(JOUT,4154),OP1
26100 1601 IF(NWX.GT.1) GO TO 1108
26300 IF(TF.GT.10.)TF=TF/60.
26400 TF=1000./TF
26500 DO 6015 K=1,30
26600 6015 COPY(K)=-9900.
26700 C INITS PARAM REPRESSION FEATURE.
26710 PLAY='PLAY;'
26800 IF(KB.EQ.0)GO TO 9926
26900 ML=NINS+1
27000 NL=NINS+KB
27100 DO 9826 K=ML,NL
27119 BW=OTH(K-NINS,1)
27128 IF(BW.NE.-99)GO TO 9826
27132 PLAY=' '
27137 K=K-NINS
27146 GO TO 5741
27155 C 'INSERT -99;' COMES BEFORE 'PLAY;'
27164 9726 BW=19999.
27173 K=K+NINS
27182 9826 BG(K)=BW
27191 C 'OTH' INSERTS, WITH BG TIME IN SECONDS, CAN ONLY BE SET WITH TF=1
27400 9926 DO 5015 K=1,NINS
27500 IQ(K)=BG(K)*10000.
27600 BG(K)=0
27700 INP(K)=0
27800 P1(K)=0
27900 IF(DUR(K).LT.10000.)DUR(K)=DUR(K)-.0001
28000 C******* FEB. 16,71 FOR ROUND-OFF NONSENSE
28100 5015 CNT(K)=0
28200 IF(MX)WRITE(1,1023)ISLAC,PLAY
28220 IF(MZ)WRITE(JOUT,1023),ISLAC,PLAY
28300 BW=0
28400 GO TO 500
00100 752 FORMAT(1X15A5)
00200 1108 M=0
00300 JC=0
00400 IF(NWZ)GO TO 1740
00500 C NWZZ IS SET AT 3111 IN SORTR.
00600 DO 740 K=1,NWZZ
00700 X=BNW(K)
00800 IF(X-.0001.GT.BT.OR.X.LE.BW.OR.BW)GO TO 2740
00900 IT(J)=IT(J)*10
01000 NW=K
01100 GO TO 600
01200 2740 IF(X.LT.1000..OR.X-J*10000.NE.CNT(J)+1.)GO TO 740
01300 X=BT+PR
01400 NW=K
01500 BX=CNT(J)+1.
01600 IT(J)=-3
01700 GO TO 600
01800 740 CONTINUE
01900 IT(J)=0
02000 1740 IF(J.LE.NINS)GO TO 31
02100 7021 K=J-NINS
02200 IF(JC.GT.0)K=JC
02300 5740 IF(PP1.LT.OP1)GO TO 1752
02400 5741 IF(MZ)WRITE(JOUT,752),(OTH(K,L),L=2,16)
02500 IF(MX)WRITE(1,752)(OTH(K,L),L=2,16)
02600 C IF TF .NE.1, ALL INSERT TIMES MUST BE RESET
02700 C IF FIRST PART OF NOTE LIST IS 'OMITTED', CHECK YOUR 'INSERTS'.
02800 DO 17521 L=3,30
02900 17521 COPY(L)=-9900.
03000 C SO THAT ALL PARAMS WILL PRINT,AFTER AN INSERT.
03100 1752 BG(K+NINS)=19999.
03200 OTH(K,1)=19999.
03210 IF(BW.EQ.-99)GO TO 9726
03300 IF(JC.GT.0)GO TO 21
03400 31 KL=1
03500 IF(KB.EQ.0)GO TO 2031
03600 DO 1031 L=1,KB
03700 K=L
03800 X=OTH(K,1)-1000000.
03900 M=X/100000.
04000 IF(M.NE.J.OR.IQ(J).NE.0)GO TO 1031
04100 C M=INST
04200 IF(X-M*100000.EQ.CNT(J)+1)GO TO 5740
04300 1031 CONTINUE
04400 IF(J.GT.NINS)GO TO 500
04500 2031 CNT(J)=CNT(J)+1
04600 ICT=CNT(J)
04700 C INSERT TRAP HERE FOR OVERLAP OF RESTARTED INSTS.******
04800 NPA=NP(J)
04900 PP1=P1(J)
05000 IF(BT.GE.DUR(J))GO TO 5174
05100 IF(IQ(J).EQ.0)GO TO 200
05200 P2=-IQ(J)/10000.
05300 IQ(J)=0
05400 CNT(J)=-1
05500 ICT=-1
05600 GO TO 4203
05700
05800 C MK IS FLAG FOR RESTS
05900 200 MK=0
06000 IF((BT.EQ.0.AND.J.EQ.1).OR.IPT(J,1).EQ.0)GO TO 203
06100 KN=IPT(J,1)-1
06200 IF(KN.GT.0)GO TO 12033
06300 12032 KN=JPT(-KN)
06400 IF(KN)GO TO 12032
06500 KN=KN-1
06600 C FOR 'ALL' IN P32. FOLLOWS UP ON POINTERS TO POINTERS!
06700 C SOMEDAY PUT P1(32) IN WITH OTHER PARAMS BELOW!!!!
06800 12033 IJ=V(KN)
06900 IF(ABS(V(KN)).EQ.4.)GO TO 1203
07000 C 'IABS' IS FOR -4 USED WITH 'ALL'
07100 Z=(BT+9900.+V(KN-2))/V(KN+2)
07200 C******* FEB 19,71
07300 IF(Z.GT.1.)Z=1.
07400 Y=V(KN+3)
07500 X=(V(KN+4)-Y)*Z+Y
07600 C******* FEB 19,71
07700 CC****** TAKEN OUT NOV 9,72 ??? IF(X.EQ.0)IPT(J,1)=0
07800 GO TO 204
07900 1203 X=V(KN+3)
08000 204 Y=RAND(0.0,1.0)
08100 IF(Y-X)MK=-1
08200
08300 203 DF=1.
08400 C DF=DUTY FACTOR
08500 DO 2155 L=2,NPA
08600 ISUB=0
08700 C WHY DOES ISUB APPEAR AT 14700/5?
08800 IDF=0
08900 C IDF IS DUTY FACTOR FLAG
09000 IJ=IPT(J,L)
09100 12031 IF(IJ)IJ=JPT(-IJ)
09200 IF(IJ)GO TO 12031
09300 C FOLLOWS UP ON POINTERS TO POINTERS!
09400 PM=1.
09500 IF(IJ.GT.1)GO TO 2157
09600 P(L)=0
09700 CC GO TO 21552
09800 GO TO 21551
09900 C 7/73
10000 2157 LN=IJ+2
10100 NM=ABS(V(IJ-1))+LN-4
10200 NL=V(IJ)
10250 IF(NL.GT.-100)GO TO 272
10300 IF(NL.GT.-200)GO TO 372
10400 ISUB=-1
10500 NL=NL+200
10600 C FOR SUBROUTINE FLAG
10700 372 IF(NL.GT.-100)GO TO 272
10800 IDF=-1
10900 NL=NL+100
11000 C DEC.6,72 FINDS DUTY FACTOR PARAM
11100 272 VIJ2=V(IJ+1)
11200 KN=NL/(-11)
11300 IF(KN.EQ.0)GO TO 1100
11400 GO TO (61,62,62,62,65,65,67,68),KN
11500 1100 IF(VIJ2.EQ.1.)GO TO 1200
11600 ML=3
11700 1900 KA=1
11800 VX1=0
11900 DO 1156 K=LN,NM,ML
12000 VX(KA+1)=V(K)+VX(KA)
12100 1156 KA=KA+1
12200 X=RAND(0.0,1.)
12300 DO 1157 K=2,11
12400 IF(X.GT.VX(K))GO TO 1157
12500 KL=K-1
12600 IF(KN.EQ.7)GO TO 6157
12700 GO TO 1400
12800 1157 CONTINUE
12900 1400 LN=IJ+3*KL
13000 1462 RA=V(LN)
13100 IF(RA.EQ.10000.)GO TO 5174
13200 C FOR "FINE" IN RLIST
13300 RB=V(LN+1)
13400 PAR=RAND(RA,RB)
13500 1300 IF(NL.NE.-1)PM=2.
13600 C IF 2 THEN PRINTS A5
13700 GO TO 1155
13800 1200 PAR=V(IJ+2)
13900 GO TO 1300
14000 C NEXT IS FOR SUBROUTINE AND QUAD CALLS
14100 61 IF(NL.LT.-12)GO TO 6100
14200 601 X=P2
14300 CC IF(NL.EQ.-11)PL(L)=2.
14400 C '.5' MAKES ALL SUBR PARAMS PRINTOUT.
14500 CALL SUBR
14600 C******MAY 25,71
14700 CC IF(P(L).EQ.10000.)GO TO 5174
14800 IF(DF)GO TO 5174
14900 C DF=-1 IN 'SUBR' WILL CAUSE 'END' FOR INST.
15000 CC PM=PL(L)
15100 IF(L.EQ.2)GO TO 4203
15200 IF(X.EQ.P2)GO TO 21552
15300 PP2=P2
15400 PR=P2
15500 GO TO 21552
15600 C ABOVE IS FOR P2 CHANGES IN SUBROUTINE
15700 C TF,TEMPO,CONDUCT WILL AFFECT P2 ONLY WHEN P2 CALLS THE SUBR.,
15800 C ALL 'TEMPO' CHANGES WILL BE IGNORED!! (THEN DUR. IN SECS. MUST
15900 C BE SET TO 'REAL TIME'.)
16000
16100 C NEXT IS FOR QUAD ROUTINES
16200 6100 CALL QUAD(NL)
16300 GO TO 21552
16400
16500 C FOLLOWING IS FOR STRINGS OF VALUES.
16600 62 KL=NCNT(J,L)+1
16700 IF(KL.GT.VIJ2)KL=1
16800 IF(NL.NE.-46.AND.NL.NE.-36)GO TO 162
16900 C THIS PART FOR STRINGS OF RAND SELECTION
17000 LN=KL+IJ+1
17100 KL=KL+1
17200 IF(KL.GT.VIJ2)KL=1
17300 NL=NL+45
17400 C FOR NUMBERS ONLY SO FAR(THIS MAKES NL=-1. FOR NOTES, =9)
17500 162 NCNT(J,L)=KL
17600 IF(NL.GT.-22)GO TO 1462
17700 C JUMP RAND SELECTION
17800 PAR=V(IJ+KL+1)
17900 C********** MAY 13,71 RHY REPEAT FEATURE OMITTED.
18000 C************************
18100 CC DEC.6,72 IF(NL.EQ.-45)DF=PAR
18200 IF(KN.NE.3)GO TO 1155
18300 C*******JULY 16,71 IF(PAR.EQ.101.)GO TO 5174
18400 IF(PAR.EQ.10000.)GO TO 5174
18500 PM=2.
18600 IF(PAR.GT.100..OR.PAR.LT.1.)PM=3.
18700 IF(PAR.EQ.85.)MK=-1
18800 GO TO 5155
18900 65 W=-9900.-V(IJ-3)
19000 C W=BG TIME OF MOVE.
19100 X=ABS(V(IJ-1))
19200 IF(NL.EQ.-56.OR.NL.EQ.-58)PM=2.
19300 Z=(BT-W)/VIJ2
19400 C Z= % OF WAY THROUGH.
19500 IF(Z.GT.1.)Z=1.
19600 Y=V(LN)
19700 W=V(IJ+3)
19800 IF(X.EQ.7.)W=V(IJ+4)
19900 IF(NL.LT.-58)GO TO 16002
20000 PAR=(W-Y)*Z+Y
20100 IF(X.EQ.7.)GO TO 1600
20200 GO TO 1155
20300 C************** JUNE 1,71
20400 CC16002 PAR=(W-Y+1.)**Z-1.+Y
20500 C FOR "MOVX"
20600 CC IF(W-Y)PAR=(Y-W+1.)**(1.-Z)-1.+W
20700 C******** FEB/73
20800 CC16002 IF(W.EQ.0)W=W+.01
20900 C THE .01 IS NEEDED FOR MOVE TO OR FROM 0.
21000 CC IF(Y.EQ.0)Y=Y+.01
21100 CC PAR=Y*((W/Y)**Z)
21200 16002 PAR=RMOVX(W,Y,Z)
21300 C SEE FUNCTION RMOVX 6/74 -- CAN'T HAVE -20→+20, ETC., -20→-40 OK.
21400 C THIS NEEDS WORK!
21500 IF(X.NE.7.)GO TO 1155
21600 W=V(IJ+5)
21700 Y=V(IJ+3)
21800 CC X=(W-Y+1.)**Z-1.+Y
21900 CC IF(W-Y)X=(Y-W+1.)**(1.-Z)-1.+W
22000 CC IF(W.EQ.0)W=.01
22100 CC IF(Y.EQ.0)Y=.01
22200 CC X=Y*((W/Y)**Z)
22300 X=RMOVX(W,Y,Z)
22400 GO TO 16003
22500 C NEXT IS FOR MOVING RAND RANGES.
22600 C1600 PAR=(V(IJ+4)-Y)*Z+Y
22700 1600 W=V(IJ+3)
22800 C*********** BACK TO 65 IS NEW. FEB. 15,71
22900 X=(V(IJ+5)-W)*Z+W
23000 C************ JUNE 1,71
23100 16003 PAR=RAND(PAR,X)
23200 GO TO 1155
23300 67 LN=IJ+3
23400 NM=LN+VIJ2-1
23500 ML=1
23600 GO TO 1900
23700 4155 K=(PAR-9999.0)*100.+.1
23800 P(L)=P(K)
23900 PM=PL(K)
24000 GO TO 21551
24100 C ANY # OVER 9999. REPEATS ANOTHER PARAM.(9999.21 REPEATS P21)
24200 6157 LN=V(LN-1)
24300 DO 1068 K=1,KL
24400 1068 IF(K.LT.KL)LN=LN+V(LN)+1
24500 2068 PM=LN+1
24600 PAR=LN+V(LN)
24700 GO TO 5155
24800 68 KL=NCNT(J,L)
24900 IF(KL.EQ.0.OR.KL.EQ.10000)KL=VIJ2
25000 PM=KL+1
25100 PAR=PM+V(KL)-1
25200 KL=PAR+1
25300 IF(V(KL).EQ.10000.)DUR(J)=BT
25400 C 'END' OR 'FINE' IN 'LIT' LIST.
25500 IF(V(KL).EQ.999.)KL=IJ+2
25600 NCNT(J,L)=KL
25700 GO TO 5155
25800 C ******* JAN 20 *************
25900 1155 IF(PAR.EQ.10000.)GO TO 5174
26000 C TYPE 'END' AS LAST IN ANY STRING TO SET DURATION.
26100 IF((PAR.GT.9999.).AND.(PM.EQ.1.))GO TO 4155
26200 C****JULY 16,71 1155 IF((PAR.GT.9999.).AND.(PM.EQ.1.))GO TO 4155
26300 5155 P(L)=PAR
26400 21551 PL(L)=PM
26500 IF(ISUB)GO TO 601
26600 IF(L.EQ.2)GO TO 4203
26700 21552 IF(IDF.GE.0)GO TO 2155
26800 DF=PAR
26900 IDF=0
27000 2155 CONTINUE
27100
27200 9203 IF(KB.EQ.0)GO TO 1170
27300 NL=KB
27400 DO 2203 K=1,KB
27500 X=OTH(NL,1)
27600 IF(X.LT.100000.)GO TO 2203
27700 L=X/100000.
27800 Y=(X-L*100000.)/100.
27900 IX=Y
28000 JC=NL
28100 IF(J.EQ.L.AND.IX.EQ.ICT)GO TO 5203
28200 2203 NL=NL-1
28300 GO TO 1170
28400 4203 PR=P2
28500 IF(T5.EQ.0)GO TO 7203
28600 IF(IT3.LE.1.OR.BT.LT.TBG+TDUR)GO TO 6203
28700 3155 IT3=IT3+3
28800 TBG=TBG+TDUR
28900 TDUR=V(IT3)
29000 IF(BT.GE.TBG+TDUR)GO TO 3155
29100 T1=V(IT3+1)
29200 T2=V(IT3+2)
29300 CC X=2.*TDUR/(T1+T2)
29400 CC AC=2.*(TDUR-T1*X)/X**2
29500 CALL SQYY(AC,T1,T2,TDUR)
29600 6203 RA=PR
29700 IF(BT.EQ.TBG)XT(J)=T1
29800 K=IT3
29900 RC=0
30000 RD=1
30100 KA=1
30200 RB=0
30300 Z=TDUR+TBG-BT
30400 X=T1
30500 Y=T2
30600 YY=AC
30700 CHN=TBG
30800 ZZ=TDUR
30900 GO TO 4020
31000 8203 P2=RA*RD
31100 7203 P2=P2*T4
31200 X=P2*TF
31300 C P2 IS KEPT WITHOUT TF*
31400 K=X+.5
31500 IF(X)K=X-.5
31600 72031 ROFF(J)=ROFF(J)+K-X
31700 IF(ABS(ROFF(J)).LT.1.)GO TO 7155
31800 Y=1.
31900 IF(ROFF(J))Y=-1.
32000 K=K-Y
32100 ROFF(J)=ROFF(J)-Y
32200 C ROUND-OFF GAP WILL NOT EXCEED .001
32300 C*********** FEB 17,71
32400 7155 PP2=K/1000.
32500 C AVOIDS ROUND-OFF PROBLEMS
32600 IF(IPT(J,31).EQ.0)GO TO 6155
32700 IF(ICT)GO TO 1170
32800 X=V(IPT(J,31)+2)/2.
32900 Y=RAND(-X,X)
33000 IF(PP2.GE.0)GO TO 615
33100 MK=-1
33200 PP2=-PP2
33300 615 PP2=PP2-RDEV(J)+Y
33400 RDEV(J)=Y
33500 C TOTAL RAND DEV. WON'T EXCEED P31
33600 C SET P31 TO .0001 TO BRING VOICE BACK TO EXACT TIME(0 WON'T DO IT)
33700
33800 K=PP2*1000.+.5
33900 C****** CHECK THIS OUT 1/10/72 :::::::
34000 61551 PP2=K/1000.
34100 C NEVER MORE THAN .1( DEVIATION WITH RAN TF. (RTF=.05)
34200 6155 IF(ICT)GO TO 9203
34300 GO TO 2155
34400 5203 JD=Y*100-IX*100+.5
34500 IF(JD.GT.0)GO TO 3203
34600 M=0
34700 P1(J)=PP1+PP2
34800 GO TO 7021
34900 3203 P(JD)=OTH(JC,2)
35000 X=OTH(JC,3)
35100 IF(X.NE.1.)X=3.
35200 C 'EDITS' PRINT,NUM. OR 5 CHARS.
35300 PL(JD)=X
35400 C NEXT ADDED NOV.72 CHECK FOR SIDE AFFECTS !!!!! **********
35500 IF(JD.EQ.2)PP2=P2
35600 C 'TF' AND 'TEMPO' WILL NOT AFFECT PP2 'EDITS'.
35700 1170 IF(MK.OR.PP2)GO TO 2022
35800
35900 ZPAR=PP1
36000 P1(J)=PP1+PP2
36100 C ZPAR IS USED HERE WHEN OP1(OMIT) IS .GT.0. OMIT IS IN REAL TIME.
36200 LK=INST(J)
36300 2021 IF(PP1.LT.OP1)GO TO 2612
36400 IF(INVIS(J).LT.0)GO TO 2170
36500 C ALL PARAMS WILL PRINT,1ST TIME WHEN USING 'OMIT'.
36600 IF(INONLY.GT.0)GO TO 1204
36700 C*********** MAY 16,71 ↑↑↑
36800 6021 IF(P(NPA).NE.COPY(NPA).OR.PL(NPA).GT.1)GO TO 5021
36900 C******* MAY 25,71
37000 C 'LIT' DATA WILL ALWAYS PRINT.
37100 NPA=NPA-1
37200 IF(NPA.GT.2)GO TO 6021
37300 5021 DO 1304 K=3,NPA
37400 1304 COPY(K)=P(K)
37500 1204 IF(PL4.NE.1.)GO TO 2170
37600 P4=P4*AMPFAC
37700 L=0
37800 INP(J)=P4
37900 DO 1021 K=1,NINS
38000 1021 IF(P1(K).GT.PP1)L=L+INP(K)
38100 IF(L-IAMP-1)GO TO 2170
38200 IAMP=L
38300 AMPTIM=PP1
38400 2170 IF(MX.EQ.3)GO TO 2612
38500 C ********* MAY 17,71
38600 PP1=PP1-OP1
38700 C PUTS SPACES BETWEEN NOTES .GT. .05( APART
38800 IF((MZ.NE.-1).OR.(A.GE.PP1))GO TO 5170
38900 IF(INONLY)WRITE(JOUT,902)
39000 A=PP1+.05
39100 5170 ML=10
39200 IF(NPA.LT.10)ML=NPA
39300 MLX=3
39400 NL=2
39500 IF(INVIS(J).EQ.0)GO TO 3170
39600 CC5170 IF(INVIS(J).EQ.0)GO TO 3170
39700 CC MLX=3
39800 LK=0
39900 C NEEDED TO INIT INVISIBLE MODE PRINT-OUT (NO INST NAME, P1, P2)
40000 C NEXT CREATES FORMAT DATA IN IFM ARRAY.
40100 31701 KL=3
40200 GO TO 4170
40300 3170 IF(.NOT.INONLY.AND.J.NE.INONLY)GO TO 2612
40400 VX(1)=PP1
40410 IF(DF.GT.0)GO TO 6170
40418 VX2=-DF
40426 IF(VX2.GT.PP2)VX2=PP2
40434 C NEG. DF=FIXED NOTE DUR. NOT.GT.PP2 7/74 COLGATE -AND BELOW
40442 GO TO 7170
40450 6170 IF(DF.LT.100)GO TO 8170
40458 C DF>100 = FIXED REST AREA BEFORE NEXT ATTACK.
40466 VX2=PP2-DF+100.
40474 IF(VX2.LE.0)VX2=PP2/2.
40482 C NO NEG. TIME VALUES ALLOWED.
40490 GO TO 7170
40500 8170 VX2=PP2*DF
40600 7170 IFM3='F9.3,'
40700 IFM4=IFM3
40800 KL=5
40900 CC ML=10
41000 CC IF(NPA.LT.10)ML=NPA
41100 CC MLX=3
41200 CC NL=2
41300 IF(NPA.LT.3)GO TO 2121
41400
41500 4170 NL=2
41600 DO 1121 K=MLX,ML
41700 X=P(K)
41800 L=PL(K)
41900 IF(L-2)321,521,621
42000 321 IF(X.GE.0)GO TO 4211
42100 IFM(KL)=IFCOM
42200 NL=NL+1
42300 KL=KL+1
42400 4211 IFM(KL)='F9.3,'
42500 C CREATES 'F9.3'
42600 421 VX(KL-NL)=X
42700 GO TO 1121
42800 521 IFM(KL)=IFM2
42900 C CREATES '1XA5'
43000 LN=X
43100 VX(KL-NL)=SCAL(LN)
43200 GO TO 42
43300 621 IF(L.GT.3)GO TO 721
43400 VX(KL-NL)=X
43500 C ABOVE LETS A5 WD BE USED IN SUBR BY SETTING PL(N)=3.
43600 42 IFM(KL)=IFM2
43700 GO TO 1121
43800 721 LN=X
43900 IFM(KL)=I1X
44000 NL=NL+1
44100 DO 821 M=1,LN-L+1
44200 KL=KL+1
44300 IOUT(KL-NL)=IV(L-1+M)
44400 821 IFM(KL)=IA1
44500 1121 KL=KL+1
44600
44700 C NO MORE THAN 80 ITEMS IN FORMAT.
44800 2121 IF(KL.LE.80)GO TO 21211
44900 21212 FORMAT(' ERROR! TOO MANY LIT. ITEMS')
45000 TYPE 21212
45100 21211 DO 921 M=KL+1,80
45200 921 IFM(M)=IBLA
45300 IFM(KL)=')'
45400 L=KL-NL-1
45500 IF(MX)WRITE(1,IFM)LK,(VX(K),K=1,L)
45600 IF(.NOT.MZ)GO TO 30210
45700 IF(ML.GE.NPA)IFM(KL)='$)'
45800 WRITE(JOUT,IFM),LK,(VX(K),K=1,L)
45900 30210 IF(ML.GE.NPA)GO TO 3021
46000 MLX=ML+1
46100 ML=ML+10
46200 IF(ML.GT.NPA)ML=NPA
46300 LK=IBLA
46400 GO TO 31701
46500 3021 IF(MX)WRITE(1,3616)INST(J),ICT
46600 30211 IF(MZ)WRITE(JOUT,8902),J,INST(J),ICT,BT
46700 2612 PP1=ZPAR
46800 GO TO 21
46900 8902 FORMAT('+;<'I2,1XA5,I4,' >',F7.3)
47000 3616 FORMAT(';PRINT(P1);< ',A5,I4)
47100 C PRINTS RESTS
47200 2022 PP2=ABS(PP2)
47300 C IN THIS VERSION TYPE 'R' FOR RESTS IN ANY PARAM BUT P2.
47400 C FOR RESTS IN SEQS. TYPE -DUR.
47500 C WHEN RANDOM RESTS ARE CHOSEN, SEQS. MISS NOTES.
47600 C RAN RESTS ARE NOT TOUCHED BY SUBROUTINES!!!
47700 INP(J)=0
47800 P1(J)=PP1+PP2
47900 C STORES NEXT P1 TIME FOR THIS INST.
48000 IF((MZ.NE.-1).OR.(PP1.LT.OP1))GO TO 21
48100 X=PP1-OP1
48200 IF(A.GE.X)GO TO 121
48300 WRITE(JOUT,902)
48400 A=X+.05
48500 121 IF(INONLY.OR.J.EQ.INONLY)WRITE(JOUT,1110),INST(J),X,PP2,
48600 1 J,INST(J),ICT
48700 21 PR=ABS(PR)
48800 BG(J)=BT+PR
48900 IF(ICT.EQ.DUR(J)-10000.)GO TO 5174
49000 IF(BG(J).LT.DUR(J))GO TO 500
49100 5174 BG(J)=19999.
49200 DO 3174 K=1,NINS
49300 C INSERTS CANT FOLLOW LAST REGULAR NOTE.
49400 C (ADD REST IF INSERT AT END IS NEEDED.)
49500 3174 IF(BG(K).LT.19999.)GO TO 500
49600 GO TO 175
49700 C CHOOSES INST WITH NEXT BEGIN TIME.
49800 500 J=1
49900 BW=BT
50000 NL=NINS+KB
50100 DO 22 K=2,NL
50200 22 IF(BG(J).GT.BG(K))J=K
50300 IF(J.GT.NINS.OR.NINS.EQ.1)GO TO 3022
50400 J=1
50500 DO 5022 K=2,NINS
50600 X=P1(J)
50700 Y=P1(K)+.0001
50800 C LOWEST NUMBERED INST WILL COME 1ST IF BG TIMES ARE VERY CLOSE
50900 IF(BG(J).EQ.19999.)X=19999.
51000 IF(BG(K).EQ.19999.)Y=19999.
51100 5022 IF(X.GT.Y)J=K
51200 C ABOVE IS FOR ROUND-OFF PROBLEMS WITH 'TEMPO' AND 'CONDUCT'.
51300 3022 BT=BG(J)
51400 IF((BT.EQ.19999.).OR.(P1(J).GE.DURX))GO TO 175
51500 IF(CNT(J).GT.0)GO TO 1022
51600 IF(CNT(J).EQ.0)P1(J)=0
51700 IF(CNT(J).EQ.-1)CNT(J)=0
51800 C N.B. 'TF' CONTROLS BG TIME WHEN BG .GT. 0
51900 1022 IF((BT.LT.T6).OR.(IT3.GT.1))GO TO 1108
52000 T4=T2
52100 T5=0
52200 T6=10000.
52300 GO TO 1108
52400 1175 FORMAT('+',A5,'=',F7.3,2X,$)
52500 1109 FORMAT(' FINISH; < ',A5,'.DAT')
52600 1110 FORMAT(' <',A5,2F9.3,2X,'******* REST <'I2,1XA5,I4)
52700 1603 FORMAT(' AMPL. FACTOR=',F4.2,', MAX.AMP.=',I4,', AT TIME',
52800 1 F8.3)
52900 175 IF(MZ)WRITE(JOUT,1109),ISLAC
53000 CC IF(MX.GE.0)GO TO 603
53100 IF(MX.GE.0)GO TO 4175
53200 WRITE(1,1109),ISLAC
53300 END FILE 1
53400 603 FORMAT(' TOTAL DURS: ',$)
53500 CC IF(MZ)GO TO 4175
53600 CC TYPE 1603,AMPFAC,IAMP,AMPTIM
53700 CC TYPE 603
53800 CC GO TO 5175
53900 4175 WRITE(JOUT,1603),AMPFAC,IAMP,AMPTIM
54000 WRITE(JOUT,603)
54100 5175 DO 2175 K=1,NINS
54200 X=P1(K)-OP1
54300 IF(MZ)GO TO 6175
54400 TYPE 1175,INST(K),X
54500 GO TO 2175
54600 6175 WRITE(JOUT,1175),INST(K),X
54700 2175 CONTINUE
54800 IF(JOUT.NE.22)GO TO 3175
54900 END FILE 22
55000 CALL PRINT
55100 REWIND 22
55200 K='FOR22'
55300 CALL OFILE(22,K)
55400 C LEAVES FOR22.DAT WITH 0K
55500 END FILE 22
55600 3175 TYPE 1023,ISLAC
55700 END
55800
55900 FUNCTION RMOVX(W,Y,Z)
56000 IF(W.EQ.0)W=.01
56100 IF(Y.EQ.0)Y=.01
56200 RMOVX=Y*((W/Y)**Z)
56300 END